Outlook VBA не закрывает текстовый процесс - PullRequest
Новая
       35

Outlook VBA не закрывает текстовый процесс

0 голосов
/ 12 июня 2018

У меня есть несколько сценариев VBA для Outlook, которые перебирают все выбранные электронные письма и сохраняют их в виде файла PDF, а затем перемещают в другую папку в моем Outlook.Он работает большую часть времени, однако иногда он зависает, и когда я смотрю на свои процессы, WINWORD.EXE * 32 открывается много раз.Я должен выйти из каждого из них, прежде чем Outlook возобновит работу.Outlook также иногда приводит к сбою всех, когда я пытаюсь запустить этот скрипт.Я пытался использовать позднюю привязку, но это тоже не помогает.Кроме того, у меня есть тот же код (без для каждого цикла в выборе) в форме «Правило» для другого набора электронных писем, и у него та же проблема.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 открытым.Я думаю, что я что-то упускаю.Когда я запускаю этот скрипт на компьютере коллег, словесный процесс закрывается.Я использую Windows 7, она использует Windows 10, но мы оба используем Outlook 2016. Может кто-нибудь дать мне некоторое представление о том, что я делаю неправильно?

РЕДАКТИРОВАТЬ: Прошло два дня, а не один ответ?

1 Ответ

0 голосов
/ 18 июня 2018

Я вернул Office обратно в сборку 1802 из сборки 1806, проблема, похоже, исчезла.

...