You should have added the line where I indicated, not added both lines, as that simply screws things up. The CreateFolders line was already present.
It seems you have now crashed Word and it is running as a background task with the temporary file open. You might be able to open Word and close the file or you can force Word closed using Task Manager (or reboot).
Private Sub SaveAsPDFfile(olItem As MailItem)'Graham Mayor - https://www.gmayor.com - Last updated - 15 Jul 2019 Dim olNS As NameSpace Dim fso As Object, TmpFolder As Object Dim tmpPath As String Dim strFileName As String Dim oRegex As Object Set olNS = Application.GetNamespace("MAPI") 'Get the user's TempFolder to store the temporary file Set fso = CreateObject("Scripting.FileSystemObject") tmpPath = fso.GetSpecialFolder(2) 'construct the filename for the temp mht-file strName = "email_temp1.mht" tmpPath = tmpPath & "\" & strName 'Save temporary file olItem.SaveAs tmpPath, 10 'Open the temporary file in Word Set wdDoc = wdApp.Documents.Open(fileName:=tmpPath, _ AddToRecentFiles:=False, _ Visible:=False, _ Format:=7) 'Create a file name from the message subject strFileName = Format(olItem.ReceivedTime, "yyyymmdd hh.mm") & "-" & olItem.SenderName & "-" & olItem.Subject 'Remove illegal filename characters Set oRegex = CreateObject("vbscript.regexp") oRegex.Global = True oRegex.Pattern = "[\/:*?""<>|]" strFileName = Trim(oRegex.Replace(strFileName, "")) strSavePath = strPath & strFileName CreateFolders strSavePath 'add this line to save the message as msg format SaveUnique olItem, strSavePath, strFileName strFileName = strFileName & ".pdf" strFileName = FileNameUnique(strSavePath, strFileName, "pdf") strFileName = strSavePath & strFileName 'Save As pdf wdDoc.ExportAsFixedFormat OutputFilename:= _ strFileName, _ ExportFormat:=17, _ OpenAfterExport:=False, _ OptimizeFor:=0, _ Range:=0, _ From:=0, _ To:=0, _ Item:=0, _ IncludeDocProps:=True, _ KeepIRM:=True, _ CreateBookmarks:=0, _ DocStructureTags:=True, _ BitmapMissingFonts:=True, _ UseISO19005_1:=False ' close the document wdDoc.Close 0 lbl_Exit: 'Cleanup Set olNS = Nothing Set olItem = Nothing Set wdDoc = Nothing Set oRegex = Nothing Exit Sub End Sub




Reply With Quote