改进VBA代码-运行后使单词实例保持打开状态

时间:2019-02-13 15:00:43

标签: excel vba

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

到目前为止,我的代码是:

私人子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

1 个答案:

答案 0 :(得分:1)

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