Улучшение кода VBA - он сохраняет экземпляр слова открытым после запуска

Question

У меня есть Excel-код для генерации отдельных текстовых документов.Все работает нормально.Единственная проблема заключается в том, что после запуска кода и закрытия Excel в диспетчере задач все еще работает один экземпляр слова.Может кто-нибудь помочь мне исправить это?

Мой код на данный момент:

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

Answer 1

Попробуйте добавить wordApp.Quit прямо перед Set wordApp = Nothing