Код работает каждый раз в VBA

Question

Код ниже запрограммирован для извлечения данных из таблицы MS ACCESS 2010 и помещается в форму MS WORD 2010 b. Код работает отлично каждый раз и выбрасывает ошибку NO, но открывает документ и помещает данные только через другое время.

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

Я не вижу закрытия соединения. Падение кода приведет к его закрытию, поэтому он будет работать в следующий раз. попробуйте rs.close в конце.