Question

我有一些Outlook VBA脚本循环遍历所有选定的电子邮件，并将它们保存为PDF文件，然后将它们移动到我的Outlook中的另一个文件夹。它大部分时间都可以工作，但有时它会挂起，当我查看我的进程时，WINWORD.EXE * 32会多次打开。在Outlook恢复工作之前，我必须退出每个人。当我尝试运行此脚本时，Outlook也会偶尔崩溃所有人。我尝试过使用后期绑定，但这也没有帮助。此外，我在规则＆＃39;中有相同的代码（没有选择中的每个循环）。另一组电子邮件的表单，它有同样的问题。 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

我认为这可能是针对每个循环的，但是规则版本仍然会让winword.exe * 32保持打开状态。我想我一定是在忽略一些事情。当我在同事计算机上运行此脚本时，单词process似乎正在关闭。我使用的是Windows 7，她使用的是Windows 10，但我们都在使用Outlook 2016。有人可以告诉我一些关于我做错的事情吗？

编辑：这是两天而不是一个回复？

Answer 1

我将Office从1806版本恢复为构建1802，问题似乎已经消失。

Outlook VBA未关闭Word进程

1 个答案: