Outlook VBA 未關閉 Word Process

Question

我有一些 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 process 似乎正在關閉。 我使用的是 Windows 7，她使用的是 Windows 10，但我們都使用 Outlook 2016。

Answer 1

我將 Office 從 build 1806 恢復到 build 1802，問題似乎已經消失。