Marie
Marie

Reputation: 11

Improve VBA Code - it keeps word instance open after running

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

Answers (1)

Try adding wordApp.Quit right before Set wordApp = Nothing

Upvotes: 1

Related Questions