我目前正在使用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
答案 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 = ""