Reputation: 11
I have got an Excel-Code to generate singular word-mailmerged-documents. It all work fine. The only problem is that after running the code and closing excel there is still one word instance running in the taskmanager. Can someone help me fixing this?
My code so far is:
Private Sub CommandButton1_Click()
Dim wordApp As Word.Application
Dim wordTemplate As Word.Document
Dim wordMergedDoc As Word.MailMerge
Dim sourceBookPath As String
Dim sheetSourceName As String
Dim excelColumnFilter As String
Dim queryString As String
Dim baseQueryString As String
Dim wordTemplateDirectory As String
Dim wordTemplateFileName As String
Dim wordTemplateFullPath As String
Dim wordOutputDirectory As String
Dim wordOutputFileName As String
Dim wordOutputFullPath As String
Dim idListValues As Variant
Dim idValue As Integer
Dim idCounter As Integer
Dim recordCounter As Integer
Dim fileCounter As Integer
idListValues = Array(1, 2, 3, 4, 5, 6, 7)
sourceBookPath = ThisWorkbook.FullName
sheetSourceName = "Sheet1"
excelColumnFilter = "Anz"
baseQueryString = "SELECT * FROM `" & sheetSourceName & "$` where `" & excelColumnFilter & "` = [columFilterValue] order by `" & excelColumnFilter & "` ASC"
' Word:
wordTemplateDirectory = ThisWorkbook.Path & "\"
wordTemplateFileName = "sb[columFilterValue].docx"
wordOutputDirectory = ThisWorkbook.Path & "\"
wordOutputFileName = "MailMergeDifferent[columFilterValue]_[Record]"
Set wordApp = New Word.Application
wordApp.Visible = False
wordApp.DisplayAlerts = wdAlertsNone
MsgBox "Verteidigungsanzeigen werden erstellt, bitte kurz warten :)", vbOKOnly + vbInformation, "Information"
For idCounter = 0 To UBound(idListValues)
idValue = idListValues(idCounter)
queryString = Replace(baseQueryString, "[columFilterValue]", idValue)
wordTemplateFullPath = wordTemplateDirectory & Replace(wordTemplateFileName, "[columFilterValue]", idValue)
Set wordTemplate = wordApp.Documents.Open(wordTemplateFullPath)
Set wordMergedDoc = wordTemplate.MailMerge
With wordMergedDoc
.MainDocumentType = wdFormLetters
.OpenDataSource _
Name:=sourceBookPath, _
ReadOnly:=True, _
Format:=wdOpenFormatAuto, _
Revert:=False, _
AddToRecentFiles:=False, _
LinkToSource:=False, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=" & sourceBookPath & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:=queryString
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
For recordCounter = 1 To .DataSource.RecordCount
With .DataSource
.FirstRecord = wordMergedDoc.DataSource.ActiveRecord
.LastRecord = wordMergedDoc.DataSource.ActiveRecord
Dokumentenname = .DataFields("ID")
End With
.Execute Pause:=False
wordOutputFullPath = wordOutputDirectory & Replace(Replace(wordOutputFileName, "[columFilterValue]", idValue), "[Record]", recordCounter)
wordApp.ActiveDocument.SaveAs2 Filename:=wordOutputDirectory & Dokumentenname & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
wordApp.ActiveDocument.Close SaveChanges:=False
.DataSource.ActiveRecord = wdNextRecord
fileCounter = fileCounter + 1
Next recordCounter
End With
wordTemplate.Close False
Next idCounter
wordApp.Visible = False
Set wordApp = Nothing
MsgBox "Geschafft! Es wurden " & fileCounter & " Verteidigungsanzeigen erstellt", vbOKOnly + vbInformation, "Information"
End Sub
Upvotes: 0
Views: 285
Reputation: 11978
Try adding wordApp.Quit
right before Set wordApp = Nothing
Upvotes: 1