Hi Guys
The following code works fine. It exports the word document in the folder but it also displays the word document on the screen after. I don't want that . No message , no display on the screen . Can you please tell me what change I need to make in this? I tried changing True to False but didn't work
Code:
Public Sub ExportForm()
Dim db As DAO.Database
'define query object parameter
Dim qry As DAO.QueryDef
Dim I As Integer
Dim rsMailmerge As Recordset
Dim strTextFile As String
Dim strTemplatePath As String
Dim strSavePath As String
Dim strSaveName As String
'Me.txtHidden.SetFocus
strTemplatePath = DLookup("[Variable]", "tblVariable", "VariableID=15")
strSavePath = DLookup("Variable", "tblVariable", "VariableID=16")
strSaveName = "Form " & Format(Now(), "yyyymmdd_hhmmss") & " " & Me.cboAgent.Column(1) & ".doc"
'set current datedate as database objects
Set db = CurrentDb
'set your record set using reference from the form
Set rsMailmerge = db.OpenRecordset("select * from tblAudit where [AuditID] =" & Me.AuditID)
'Call GetWordHandle
'function that opens word to run in the background, function can be placed in a global module
If WordApp Is Nothing Then ' if word not called before
Err.clear ' Clear Err object in case error occurred.
Set WordApp = CreateObject("Word.Application") 'Start a new word application
Else
' an instance of word has been created before
On Error Resume Next 'Turn off error handling
Err.clear ' Clear Err object in case error occurred.
WordApp.Visible = False 'attempt to access previous instance of word
If Err.Number <> 0 Then ' if instance of word no longer exists then create a new one
Err.clear ' Clear Err object
Set WordApp = CreateObject("Word.Application") 'Start a new word application
On Error GoTo 0 'Revert to normal error handling
End If
End If
'Hide word (it will be made visible again CloseOrEditDocument or if an error occurs)
WordApp.Visible = False
WordApp.WindowState = 2
WordApp.Visible = False
'next we are going to create a text file that that the word template will merge with
'_________________________________________________________________________________________
'text file file name
strTextFile = "Call Audit_" & Me.cboAgent.Column(1) & "_" & Format(Now(), "yyyy_mm_dd_hh_nn_ss")
'function that creates and saves the text file
createKFIMailMergefile strPath, strTextFile & ".txt"
'open template
Set WordDoc = WordApp.Documents.Open(strTemplatePath & "Form-New.dot")
'merge template with txt file
WordDoc.MailMerge.MainDocumentType = 0
WordDoc.MailMerge.Destination = wdSendToNewDocument
WordDoc.MailMerge.OpenDataSource (strPath & strTextFile & ".txt")
WordDoc.MailMerge.Execute
'Go through all created doc and remove all mail merge errors
For I = 1 To WordApp.Application.Documents.Count
If InStr(1, WordApp.Application.Documents(I).Name, "Error") <> 0 Then
WordApp.Application.Documents.Item(I).Close False
I = I - 1
End If
If I = WordApp.Application.Documents.Count Then Exit For
Next I
'Save merged document as new file
WordApp.ActiveDocument.AttachedTemplate.Saved = True
WordDoc.Application.Documents.Item(1).SaveAs strSavePath & strSaveName, , , , False, , True
'Go through all created doc and close them
For I = 1 To WordApp.Application.Documents.Count
WordApp.Application.Documents.Item(WordApp.Application.Documents.Count).Close False
Next I
'WordDoc.Close
'WordApp.Quit
'delete the text file
Kill strPath & strTextFile & ".txt"
Me.chkSaved = True
'delete the subs
exithere:
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Set qry = Nothing
Set db = Nothing
MsgBox ("Export Completed")
Application.FollowHyperlink strSavePath & strSaveName
Exit Sub
exporterror:
Resume exithere
End Sub