Link to home
Start Free TrialLog in
Avatar of GileadIT
GileadITFlag for United States of America

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

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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Bitsqueezer
Bitsqueezer
Flag of Germany image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of GileadIT

ASKER

Thanks Christian for your help. I can't wait to see the code in action when I get into the office. I will let you know what happens and update this thread accordingly.

Thanks,
Joe
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.