GileadIT
asked on
Outlook 2007 VB Code Problem
I have posted some code below which allows me to take every item in an Outlook 2007 folder and convert it to a PDF document in a directory on my PC. The script used to work great but about 2 months ago stopped working and I cannot figure out why. Now when the script is run, Microsoft Word will be shown in the task manager as running but it will never save the document it is working on - I have to manually stop the process. Can someone look at this and see if you can determine why the code no longer works?
Thanks,
Joe
Thanks,
Joe
Sub processFolder()
'use the default folder
Set MyCurrentFolder = Application.ActiveExplorer.CurrentFolder
For Each itm In MyCurrentFolder.Items
If itm.Categories = "Purple Category" Then
'Get the user's TempFolder to store the item in
Dim FSO As Object, TmpFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set tmpFileName = FSO.GetSpecialFolder(2)
'construct the filename for the temp mht-file
strName = "temp"
tmpFileName = tmpFileName & "\" & strName & ".mht"
'Save the mht-file
itm.SaveAs tmpFileName, olMHTML
'Create a Word object
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
'Open the mht-file in Word without Word visible
Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)
'Get location of My Documents folder
Dim WshShell As Object
Dim SpecialPath As String
Dim strToSaveAs As String
Set WshShell = CreateObject("WScript.Shell")
SpecialPath = "C:\Users\johndoe\Desktop\Intranet Archives\Specific Archive"
'Construct a safe file name from the message subject
Dim msgFileName As String
msgFileName = MySelectedItem.Subject & " " & MySelectedItem.ReceivedTime
Set oRegEx = CreateObject("vbscript.regexp")
oRegEx.Global = True
oRegEx.Pattern = "[\/:*?""<>|]"
msgFileName = Trim(oRegEx.Replace(msgFileName, ""))
'Save PDF
strToSaveAs = SpecialPath & "\" & msgFileName & ".pdf"
'Save as pdf
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strToSaveAs, 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
' close the document and Word
wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set oRegEx = Nothing
'Categorize the email in Yellow
itm.Categories = "1.5 Hour"
itm.Save
itm.UnRead = False
End If
Next
'Cleanup
Set MyCurrentFolder = Nothing
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
ASKER
Thanks,
Joe