Code works every other time in VBA - vba

Question

The code below is programmed to retrieve data from a MS ACCESS 2010 Table and put it into a MS WORD 2010 Form b. The code works fine every time and throws NO error but opens the document and puts the data only every other time.
Sub Module11()
Dim appWord As Word.Application
Dim conn As ADODB.Connection
Dim doc As Word.Document
Dim rst As ADODB.Recordset
Dim tnum As String
Dim sname As String
Dim frst As Integer
Dim mrst As Integer
Dim sam As Integer
Dim strSQL As String
On Error Resume Next
Err.Clear
If Err.Number <> 0 Then
Set appWord = New Word.Application
End If
Set rst = New ADODB.Recordset
Set appWord = GetObject(, "Word.Application")
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= D:\Database\Database.mdb"
rst.Open "tableSDR", conn, adOpenKeyset, adLockOptimistic
tnum = InputBox("Enter the Tracking Number of the Record " & _
"you want to find:", "TRACKING NUMBER")
strSQL = "Select * from table where rst!TrackingNumber='" & tnum & "'"
'AND " _
' & "[rst!TrackingNumber]='" & tnum & "' "
rst.Open strSQL, cn, adOpenDynamic, adLockReadOnly
sam = rst!TrackingNumber
Do While Not rst.EOF
If sam <> tnum Then
rst.MoveNext
sam = rst!TrackingNumber
Else
Exit Do
End If
Loop
Do While rst.EOF
MsgBox "Tracking Number Not Found! "
Exit Sub
Loop
Set doc = appWord.Documents.Open("D:\Database\Form.docx", True)
With doc
.FormFields("model").Result = rst!Model
.FormFields("date_submitted").Result = rst!TDate
.FormFields("part_number").Result = rst!PartNumber
.FormFields("sup_name").Result = rst!SupplierName
.FormFields("part_name").Result = rst!PartName
.FormFields("sup_location").Result = rst!SupplierLocation
.FormFields("rev_level").Result = rst!RevisionLevel
.FormFields("sup_contact").Result = rst!SupplierContact
.FormFields("po_number").Result = rst!PONumber
.FormFields("telephone_num").Result = rst!TelephoneNum
.FormFields("quantity").Result = rst!Quantity
.FormFields("fax_number").Result = rst!FaxNum
.FormFields("required_date").Result = rst!RequiredDate
.FormFields("dev_req").Result = rst!DeviationRequest
.FormFields("dev_period").Result = rst!DeviationPeriod
frst = rst!FirstTime
mrst = rst!MaterialChange
If (frst = 1) Then
If (mrst = 1) Then
doc.FormFields("time").Result = " Material Change and First Time"
ElseIf (msrt = 0) Then
doc.FormFields("time").Result = "First Time"
End If
ElseIf (frst = 0) Then
If (mrst = 1) Then
doc.FormFields("time").Result = " Material Change "
ElseIf (msrt = 0) Then
doc.FormFields("time").Result = "Not Applicable"
End If
End If
.FormFields("cur_spec").Result = rst!CurrentSPecification
.FormFields("prop_dev").Result = rst!ProposedDeviation
.FormFields("reason_dev").Result = rst!ReasonForDeviation
.FormFields("pur_sign").Result = rst!PurchaseSign
.FormFields("pur_des").Result = rst!PurchaseAD
.FormFields("pur_date").Result = rst!PurchaseDate
.FormFields("pur_com").Result = rst!PurchaseComments
.FormFields("qual_sign").Result = rst!QualitySign
.FormFields("qual_des").Result = rst!QualityAD
.FormFields("qual_date").Result = rst!QualityDate
.FormFields("qual_com").Result = rst!QualityComments
.FormFields("engg_sign").Result = rst!EnggSign
.FormFields("engg_des").Result = rst!EnggAD
.FormFields("engg_date").Result = rst!EnggDate
.FormFields("engg_com").Result = rst!EnggComments
.FormFields("manu_sign").Result = rst!ManuSign
.FormFields("manu_des").Result = rst!ManuAD
.FormFields("manu_date").Result = rst!ManuDate
.FormFields("manu_com").Result = rst!ManuComments
.FormFields("other_sign").Result = rst!OtherSign
.FormFields("other_des").Result = rst!OtherAD
.FormFields("other_date").Result = rst!OtherDate
.FormFields("other_com").Result = rst!OtherComments
.FormFields("doc_req").Result = rst!ChangeRequired
.FormFields("pca_number").Result = rst!PCANum
.FormFields("dis_comments").Result = rst!Comments
.FormFields("tracking_num").Result = rst!TrackingNumber
.Visible = True
.Activate
End With
doc.ActiveDocument.SaveAs (MSQname)
doc.Quit
Set doc = Nothing
Set rst = Nothing
Set appWord = Nothing
Set conn = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub

Answer 1

I can't see any closure of the connection. The code falling over would cause it to close thus it would work the next time. try rs.close at then end.