Excel to auto-fill word forms, check box help needed

Hi I wonder if anyone can assist.
I have a spreadsheet which auto-fills a variety of forms with the same data, PDF's them and emails them to where they need to go (various internal and external agencies). Unfortunately one of the forms is only acceptable in a word document and I am not able to adjust the form. I have a series of named form control checkboxes 'commented out' but cannot for the life of me get these to update the one in word in the same way as the 'copy_cell_to_form_field' below does.

I am very new to VBA but have managed to cobble the following together, which works perfectly for everything else. I did try a series of If, Else, End if statements (commented out) but have reduced these to shorten the pasted code

Any assistance would be fantastic :)

Gary

Quote:

---

Sub Copy_Cells_To_Word_Document()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim OutlApp As Object
Dim IsCreated As Boolean
Dim IsCreated1 As Boolean
Dim attacheddoc As String
Dim char As Variant
Dim wdfile As String

On Error Resume Next
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(FileName:=Range("Data!B27").Value, ReadOnly:=True)
wdApp.Visible = True
If Err Then
MsgBox "Template form not found", vbExclamation
wdDoc.Close
wdApp.Quit
Set wdApp = Nothing
Set wdDoc = Nothing
Exit Sub

Else

Copy_Cell_To_Form_Field wdDoc, Range("sheet!D8").Value, "CWname"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!p8").Value, "CWtel"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!D9").Value, "CWunit"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!p9").Value, "CWemail"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i12").Value, "SUfirstname"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i13").Value, "SUsurname"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i14").Value, "SUaddress"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i15").Value, "SUdob"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i16").Value, "SUnino"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i17").Value, "HOref"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!i18").Value, "deadline"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!A33").Value, "reasons"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!a62").Value, "other"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!a73").Value, "addinfo"
Copy_Cell_To_Form_Field wdDoc, Range("sheet!u80").Value, "date"
ticks
'Copy_Checkbox wdDoc, TB3IP.CheckboxState, "TB3IP"

'If TB3IP.Value = Checked Then
'wdDoc.FormFields("TB3IP").CheckBox.Value = True
'Else: wdDoc.FormFields("TB3IP").CheckBox.Value = False
'End If
'If TB3IR.Value = True Then wdDoc.FormFields("TB3IR").CheckBox.Value = True
'If TB3RL.Value = True Then wdDoc.FormFields("TB3RL").CheckBox.Value = True
'If TB3WS.Value = True Then wdDoc.FormFields("TB3WS").CheckBox.Value = True

'If TB4SM.Value = True Then wdDoc.FormFields("TB4SM").CheckBox.Value = True
'If TB4E.Value = True Then wdDoc.FormFields("TB4E").CheckBox.Value = True
'If TB4EEA.Value = True Then wdDoc.FormFields("TB4EEA").CheckBox.Value = True
'If TB4A8.Value = True Then wdDoc.FormFields("TB4A8").CheckBox.Value = True
'If TB4SV.Value = True Then wdDoc.FormFields("TB4SV").CheckBox.Value = True
'If TB4F.Value = True Then wdDoc.FormFields("TB4F").CheckBox.Value = True
'If TB4NC.Value = True Then wdDoc.FormFields("TB4NC").CheckBox.Value = True
'If TB4CR.Value = True Then wdDoc.FormFields("TB4CR").CheckBox.Value = True


'If tb5dip.Value = True Then wdDoc.FormFields("tb5dip").CheckBox.Value = True
'If tb5disa.Value = True Then wdDoc.FormFields("tb5disa").CheckBox.Value = True
'If tb5ce.Value = True Then wdDoc.FormFields("tb5ce").CheckBox.Value = True
'If tb5tc.Value = True Then wdDoc.FormFields("tb5tc").CheckBox.Value = True
'If tb5cb.Value = True Then wdDoc.FormFields("tb5cb").CheckBox.Value = True
'If tb5bbsa.Value = True Then wdDoc.FormFields("tb5bbsa").CheckBox.Value = True
'If tb5pa.Value = True Then wdDoc.FormFields("tb5pa").CheckBox.Value = True
'If tb5ba.Value = True Then wdDoc.FormFields("tb5ba").CheckBox.Value = True
'If tb5ci.Value = True Then wdDoc.FormFields("tb5ci").CheckBox.Value = True
'If tb5tn.Value = True Then wdDoc.FormFields("tb5tn").CheckBox.Value = True
'If tb5nino.Value = True Then wdDoc.FormFields("tb5nino").CheckBox.Value = True
'If tb5o.Value = True Then wdDoc.FormFields("tb5o").CheckBox.Value = True


'If year1.Value = True Then wdDoc.FormFields("year1").CheckBox.Value = True
'If year2.Value = True Then wdDoc.FormFields("year2").CheckBox.Value = True
'If year3.Value = True Then wdDoc.FormFields("year3").CheckBox.Value = True
'If year4.Value = True Then wdDoc.FormFields("year4").CheckBox.Value = True
'If year5.Value = True Then wdDoc.FormFields("year5").CheckBox.Value = True
'If year6.Value = True Then wdDoc.FormFields("year6").CheckBox.Value = True
'If year7.Value = True Then wdDoc.FormFields("year7").CheckBox.Value = True
'If yeare.Value = True Then wdDoc.FormFields("yeare").CheckBox.Value = True





wdDoc.SaveAs ("name_" & ActiveSheet.Name & "_" & Range("Subject!B2") & "_" & Range("Subject!B3") & ".doc")
End If
wdApp.Visible = True

wdDoc.Close
wdApp.Quit
Set wdApp = Nothing
Set wdDoc = Nothing



' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with attachment
With OutlApp.CreateItem(0)

' Prepare e-mail
.Subject = "Information Request - " & Range("Subject!B2") & " " & Range("Subject!B3")
.To = Range("data!B7").Value ' <-- Put email of the recipient here
.CC = "" ' <-- Put email of 'copy to' recipient here
.bcc = Range("data!B9")
.Body = "Hi," & vbLf & vbLf _
& Range("data!b12") & vbLf & vbLf _
& Range("data!b13") & vbLf _
& Range("data!b14") & vbLf _
& Range("data!b15") & vbLf _
& "" & vbLf _
& Range("Subject!B15") & vbLf _
& Range("Subject!B17") & vbLf _
& Range("Data!B17") & vbLf _
& Range("data!B18") & vbLf _
& Range("data!B19") & vbLf _
& Range("Subject!B20") & vbLf & vbLf

.Attachments.Add (ThisWorkbook.Path & "\name_" & ActiveSheet.Name & "_" & Range("Subject!B2") & "_" & Range("Subject!B3") & ".doc")

' Try to send
On Error Resume Next
.Display ' or use .Send
Application.Visible = True
If Err Then
MsgBox Range("data!B23").Value, vbExclamation
Else
MsgBox Range("data!B22").Value, vbInformation
End If
On Error GoTo 0

End With

Kill (ThisWorkbook.Path & "\name_" & ActiveSheet.Name & "_" & Range("Subject!B2") & "_" & Range("Subject!B3") & ".doc")
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
If IsCreated Then wdApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing


End Sub
Private Sub Copy_Cell_To_Form_Field(doc As Word.Document, cellValue As Variant, formFieldName As String)
Dim i As Integer
Dim wdFormField As Word.FormField
'Find the specified form field bookmark

Set wdFormField = Nothing
i = 1
While i <= doc.FormFields.Count And wdFormField Is Nothing
If doc.FormFields(i).Name = formFieldName Then Set wdFormField = doc.FormFields(i)
i = i + 1
Wend

If Not wdFormField Is Nothing Then
wdFormField.Result = cellValue
Else
MsgBox "Form field bookmark " & formFieldName & " doesn't exist in " & doc.Name
End If

End Sub

---