将.mht转换为.pdf文件并清除内存的问题

时间:2019-06-27 19:54:39

标签: excel vba outlook outlook-vba

我目前正在使用VBA循环浏览某些.msg Outlook文件,并通过中间步骤.mht转换将它们转换为.pdfs。代码将粘贴在下面。目前,我大约有40%的时间获得了正确的转化。正确的转换意味着运行该宏后,相关文件夹将具有.msg文件的正确.pdf和.mht版本。

但是,在其他60%的时间中,转换陷入从.mht到.pdf的Word中。一切都挂起了,我必须结束Word.exe进程。那是问题#1。也许与此问题相关,每当此VBA成功将文件从.msg转换为.mht转换为.pdf时,即使我不在之前的.mht文件中,也留下了我的幽灵。夹。这些文件的打字机字体信息非常有限,文件名以“〜$ NAME CUTOFF HERE”开头。我试图在运行代码尝试释放内存之后,将AND的对象设置为Nothing,然后仍会遇到问题。下面的照片也有助于说明。有人对发生的事情有任何想法吗?

从.msg到.mht的转换每次都像一种魅力。

请注意,我仅发布相关代码。此ElseIf语句上方的所有其他操作都将各种其他文件类型转换为.pdf(即.doc * 、. xls *和.ppt *)。

我以前使用过这种形式,但是想要一个。加快流程,并b。不必每次都单击“保存”。 link here.

Image of Ghost Files - Most recent run of code below with that one .msg file

'Above this is irrelevant other If statement
      ElseIf (oFile) Like ("*.msg") Then

                Dim newName4 As String
                newName4 = Replace(oFile.path, ".msg", ".pdf")
                newName4 = Replace(newName4, ".msg", ".pdf")
                Dim strHTML As String

                Dim objOL As Object
                Dim Msg As Object
                Dim Dms2 As Object
                Set objOL = CreateObject("Outlook.Application")
                Set Msg = objOL.Session.OpenSharedItem(oFile.path)

                strHTML = Left(oFile.path, InStrRev(oFile.path, Chr(46))) & "mht"

                With Msg
                    .SaveAs strHTML, olMHTML
                    .Close olDiscard
                End With

            ElseIf (oFile) Like ("*.mht") Then

                Dim newName5 As String
                newName5 = Replace(oFile.path, ".mht", ".pdf")
                newName5 = Replace(newName5, ".mht", ".pdf")

                Dim wrdApp As Word.Application
                Dim wrdDoc As Word.Document

                Set wrdDoc = Nothing
                Set wrdApp = Nothing

                Set wrdApp = CreateObject("Word.Application")
                Dim x As Integer
                x = 1
                wrdApp.Documents.Open Filename:=oFile.path, Visible:=False
                'Set wrdDoc = wrdApp.Documents.Item(x)

                wrdApp.Documents.Item(x).ExportAsFixedFormat OutputFileName:=newName5 _
                        , 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

                wrdApp.Documents.Item(x).Close
                wrdApp.Quit

                Set wrdDoc = Nothing
                Set wrdApp = Nothing

            End If

        Next oFile

1 个答案:

答案 0 :(得分:0)

回答了我自己的问题!

            ElseIf (oFile) Like ("*.msg") Then

                Dim newName4 As String
                newName4 = Replace(oFile.path, ".msg", ".pdf")
                newName4 = Replace(newName4, ".msg", ".pdf")
                Dim strHTML As String

                Dim objOL As Object
                Dim Msg As Object
                Dim Dms2 As Object
                Set objOL = CreateObject("Outlook.Application")
                Set Msg = objOL.Session.OpenSharedItem(oFile.path)

                strHTML = Left(oFile.path, InStrRev(oFile.path, Chr(46))) & "mht"

                With Msg
                    .SaveAs strHTML, olMHTML
                    .Close olDiscard
                End With

                On Error GoTo WordAppQuit
                Dim newName5 As String
                newName5 = Replace(strHTML, ".mht", ".pdf")
                newName5 = Replace(newName5, ".mht", ".pdf")
                Dim wrdApp As Word.Application
                Dim wrdDoc As Word.Document
                Set wrdDoc = Nothing
                Set wrdApp = Nothing

                Set wrdApp = CreateObject("Word.Application")
                Dim x As Integer
                x = 1
                wrdApp.Documents.Open Filename:=(strHTML)
                'Set wrdDoc = wrdApp.Documents.Item(x)

                wrdApp.Documents.Item(x).ExportAsFixedFormat OutputFileName:=newName5 _
                        , 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
WordAppQuit:
                wrdApp.Documents.Item(x).Close
                wrdApp.Quit

                Set wrdDoc = Nothing
                Set wrdApp = Nothing

                newName5 = ""