改进VBA代码 - 它在运行后保持word实例打开

问题描述 投票:0回答:1

我有一个Excel代码来生成单数的word-mailmerged文档。一切正常。唯一的问题是,在运行代码并关闭excel之后,在taskmanager中仍然运行一个单词实例。有人可以帮我解决这个问题吗?

到目前为止我的代码是:

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
excel vba
1个回答
1
投票

尝试在wordApp.Quit之前添加Set wordApp = Nothing

© www.soinside.com 2019 - 2024. All rights reserved.