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

LVL 1
GileadITAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

BitsqueezerCommented:
Hi,

I think, this should perform better:

Option Explicit

Public Sub processFolder()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim FSO As Object, TmpFolder As Object
    Dim msgFileName As String
    Dim WshShell As Object
    Dim SpecialPath As String
    ' additional declarations missing in your code:
    Dim strToSaveAs As String
    Dim MyCurrentFolder As Object
    Dim MySelectedItem As Object
    Dim tmpFileName As Object
    Dim itm As Object
    Dim oRegEx As Object
    
    Set WshShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("scripting.filesystemobject")
    
    'Create a Word object
    Set wrdApp = CreateObject("Word.Application")
    Set oRegEx = CreateObject("vbscript.regexp")

    'use the default folder
    Set MyCurrentFolder = Application.ActiveExplorer.CurrentFolder

    'Get the user's TempFolder to store the item in
    'and construct the filename for the temp mht-file
    Set tmpFileName = FSO.GetSpecialFolder(2) & "\temp.mht"

    For Each itm In MyCurrentFolder.Items
        If itm.Categories = "Purple Category" Then
            'Save the mht-file
            itm.SaveAs tmpFileName, olMHTML

            'Open the mht-file in Word without Word visible
            Set wrdDoc = wrdApp.Documents.Open(Filename:=tmpFileName, Visible:=True)

            'Get location of My Documents folder
            SpecialPath = "C:\Users\johndoe\Desktop\Intranet Archives\Specific Archive"

            'Construct a safe file name from the message subject
            msgFileName = MySelectedItem.Subject & " " & MySelectedItem.ReceivedTime

            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
            wrdDoc.Close

            Set wrdDoc = Nothing

            'Categorize the email in Yellow
            itm.Categories = "1.5 Hour"
            itm.Save
            itm.UnRead = False
        End If

    Next
    ' close Word after processing all items
    wrdApp.Quit

    'Cleanup
    Set MyCurrentFolder = Nothing
    Set MySelectedItem = Nothing
    Set tmpFileName = Nothing
    Set itm = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing
End Sub

Open in new window


You should not miss the "Option Explicit" in each and every module and then compile the project so you can see all missing variable declarations. I've added them here, maybe you've declared them somewhere else globally but that I cannot see from your code here.

Then you should always only Dim a variable at the beginning of your code, especially not in a loop. VBA is intelligent enough to ignore that but it's a better style and the code is better readable - and you will find all declarations at a defined place and do not need to search through your code.

Next is: If you use automation to control an external application and you want to open and close different documents, make sure that you start the application only once and close it at the end of your code only. You open word, open a document, close the document, close Word and then start Word again and so on. That's not only very slow, it also can lead to this behaviour of your issue. Word is of course a big application and it needs some time to start - and also to quit. DLLs must be loaded, several things must be tested (like font list of your system or printer list and so on), that all cost a lot of time. At the end all the resources must be given back to the system which is often not done immediately but by a garbage collector of the system after some time.
The VBA code starts and quits this big application very quickly in a loop and so it can be that the resources are not given back to the system but needed to be used again by the next Word application start and so it can lead to a kind of "deadlock". That's the price of a system that should be able to work with multi-users and multi-tasks.

In the new version now Word only starts right at the beginning, opens and closes all the documents in the same Word and then at the end it quits. That should be very faster than before and also it should now quit without hanging.

Cheers,

Christian
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
GileadITAuthor Commented:
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
0
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.