Outlook VBA未关闭Word进程

我有一些outlook VBA脚本，可以循环浏览所有选定的电子邮件并将它们保存为PDF文件，然后将它们移动到outlook中的另一个文件夹。 它大部分时间都能工作，但有时会挂起，当我查看我的进程时，WINWORD.EXE*32会多次打开。在Outlook恢复工作之前，我必须退出其中的每一项。当我尝试运行此脚本时，Outlook还会使每个人偶尔崩溃一次。我试过使用后期绑定，但也没有用。另外，我在另一组电子邮件的“规则”形式中有相同的代码（在选择中没有for each循环），它也有相同的问题。Word在后台打开多次，不会退出。 这是我的密码：

Option Explicit
Dim MyTicketNumber As String
    
Sub ProcessResponse()
    Response_SaveAsPDFwAtt
    MoveToResponses
End Sub

Sub Response_SaveAsPDFwAtt()

Dim fso As FileSystemObject
Dim blnOverwrite As Boolean
Dim sendEmailAddr As String
Dim senderName As String
Dim rcvdTime As String
Dim pubTime As String
Dim looper As Integer
Dim plooper As Integer
Dim oMail As Outlook.MailItem
Dim Obj As Object
Dim MySelection As Selection
Dim bpath As String
Dim EmailSubject As String
Dim saveName As String
Dim PDFSave As String



Set MySelection = Application.ActiveExplorer.Selection

For Each Obj In MySelection

    Set oMail = Obj

    ' ### Get username portion of sender email address ###
        sendEmailAddr = oMail.SenderEmailAddress
        senderName = Left(sendEmailAddr, InStr(sendEmailAddr, "@") - 1)
        rcvdTime = "_Rcvd" & Format(oMail.ReceivedTime, "yymmddhhnnss")
        pubTime = "_Pub" & Format(Now(), "yymmddhhnnss")
        MyTicketNumber = GetTicketNumber(oMail)



    ' ### USER OPTIONS ###
        blnOverwrite = False ' False = don't overwrite, True = do overwrite

    ' ### Path to save directory ###
        bpath = "L:\OpenLocates\Current\Complete\" & MyTicketNumber & "\"

    ' ### Create Directory if it doesnt exist ###
        If Dir(bpath, vbDirectory) = vbNullString Then
            MkDir bpath
        End If

    ' ### Get Email subject & set name to be saved as ###
        EmailSubject = CleanFileName(oMail.Subject)
        saveName = 2 & MyTicketNumber & rcvdTime & pubTime & ".mht"
        Set fso = CreateObject("Scripting.FileSystemObject")

    ' ### Increment filename if it already exists ###
        If blnOverwrite = False Then
            looper = 0
            Do While fso.FileExists(bpath & saveName)
                looper = looper + 1
                saveName = 2 & MyTicketNumber & rcvdTime & pubTime & "_" & Format(plooper, "0000") & ".mht"
                Loop
        Else
        End If

    ' ### Save .mht file to create pdf from Word ###
        oMail.SaveAs bpath & saveName, olMHTML
        PDFSave = bpath & 2 & MyTicketNumber & rcvdTime & pubTime & ".pdf"

        If fso.FileExists(PDFSave) Then
            plooper = 0
            Do While fso.FileExists(PDFSave)
            plooper = plooper + 1
            PDFSave = bpath & 2 & MyTicketNumber & rcvdTime & pubTime & "_" & Format(plooper, "0000") & ".pdf"
            Loop
        Else
        End If


    ' ### Open Word to convert .mht file to PDF ###
        Dim wordApp As Object
        Dim wordDoc As Object
        Dim wordOpen As Boolean
        On Error Resume Next
        Set wordApp = GetObject(, "word.application")
        On Error GoTo 0
        If wordApp Is Nothing Then
            Set wordApp = CreateObject("Word.Application")
            wordOpen = True
        End If
            

    ' ### Open .mht file we just saved and export as PDF ###
        Set wordDoc = wordApp.Documents.Open(FileName:=bpath & saveName, Visible:=True)
        wordApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        PDFSave, ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=0, To:=0, _
        item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

        wordDoc.Close
        Set wordDoc = Nothing
        If wordOpen Then wordApp.Quit
        Set wordApp = Nothing
    ' ### Delete .mht file ###
        Kill bpath & saveName

    ' ### save attachments ###
        If oMail.Attachments.Count > 0 Then
            Dim atmt As Attachment
            Dim atmtName As String
            Dim atmtSave As String
            For Each atmt In oMail.Attachments
                atmtName = CleanFileName(atmt.FileName)
                atmtSave = bpath & 2 & MyTicketNumber & rcvdTime & pubTime & "_" & atmtName
                atmt.SaveAsFile atmtSave
            Next
        End If
Next Obj

MsgBox "Process Complete.", vbInformation, "Success"
Exit_Handler:
'if i use worddoc.close and wordapp.quit with the 
'set = nothing lines here, it gives me an error saying object not found

Set oMail = Nothing
Set Obj = Nothing
Set MySelection = Nothing
Set fso = Nothing
End Sub

我认为这可能是for-each循环，但该循环的规则版本仍然保持winword.exe*32打开。我想我一定是忽略了什么。

---

当我在同事的计算机上运行此脚本时，word进程似乎正在关闭。我使用的是Windows 7，她使用的是Windows 10，但我们都使用Outlook 2016。

我将Office从版本1806恢复到版本1802，问题似乎已经解决