• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 621
  • Last Modified:

windows 7 problem with outlook macro

This macro copies all files in an outlook folder onto the hard disk. It worked fine until I recently installed windows 7 and Office10. Now it freezes on the line: If objFSO.FileExists(strRootFolderPath & strFilename) Then

and I get the error message:

Run time error 91. Object variable or with block variable not set

Do you have a suggestion on how to fix it?

Thanks,
Chris
Sub SaveAttachmentsToDiskRuleFXIP1(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\Fixing Centa FXIP Index Report\FXIP1\"
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
CC10
Asked:
CC10
  • 10
  • 4
  • 2
2 Solutions
 
ZoppoCommented:
Hi CC10,

I don't know how this macro could have worked at all. The 'objFSO' isn't initialized at all before it's used so the error 91 is absolutely correct.

Adding this line i.e. before line 9 should solve the problem:
Set objFSO = CreateObject("Scripting.FileSystemObject")

Open in new window

Hope that helps,

ZOPPO
0
 
CC10Author Commented:
It is very strange. the macros worked before. I have added the line but now get the following message

Can't find project or library

I have it in an outlook rule where i give the command to run the script.
Sub SaveAttachmentsToDiskRuleFXIP1(olkMessage As Outlook.MailItem)
    'Change the path on the following line to the folder you want the attachments save in
    Const FOLDER_PATHS = "C:\Fixing Centa FXIP Index Report\FXIP1\,C:\Users\centa\Dropbox\Centa\FXIP1\"
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String, _
        arrFolders As Variant, _
        varFolder As Variant
    arrFolders = Split(FOLDER_PATHS, ",")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            For Each varFolder In arrFolders
                strFilename = olkAttachment.FileName
                intCount = 0
                Do While True
                    If objFSO.FileExists(varFolder & strFilename) Then
                        intCount = intCount + 1
                        strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                    Else
                        Exit Do
                    End If
                Loop
                olkAttachment.SaveAsFile varFolder & strFilename
            Next
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
 
ZoppoCommented:
Hi again,

now you have the line added twice, but that shouldn't be the cause for the bug.

Could you post the exact error message including the line where it occurs?

BTW, it seems you modified the original code quite a bit - maybe you should first focus on solving the errors in the original script before adding new functionality ...

ZOPPO
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
CC10Author Commented:
Yes you are right. The problem is that I installed windows 7 and Office 10 but forgot to make a copy of the macros which all worked fine! I then found a copy of the macros from 2010 which I showed you originally but then found a copy from March 2011, which I have now used. So, first of all, my apologies for any confusion. I have now reinstalled Office 2007 enterprise but I cannot reinstall Windows Vista.
As said, I have been using these macros for two years now without a problem. I have included all the macros this time but as you will see they are all similar apart from FXIP1.

The macro freezes on:
set olkSourceFolder  (shaded blue)

I tested the FXIP3 macro and the same thing happens.

By the way I don't know why the sub MacroTest is there. I have never used it but strangely it is the only macro that shows up in the outlook macro list. The others I can only access using VB.

I have also included a screenshot
Sub MacroTest()
    MsgBox "Macros are working."
End Sub

Sub SaveAttachmentsToDiskRuleFXIP1(olkMessage As Outlook.MailItem)
    'Change the path on the following line to the folder you want the attachments save in
    Const FOLDER_PATHS = "C:\Fixing Centa FXIP Index Report\FXIP1\,C:\Users\centa\Dropbox\Centa\FXIP1\"
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String, _
        arrFolders As Variant, _
        varFolder As Variant
    arrFolders = Split(FOLDER_PATHS, ",")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            For Each varFolder In arrFolders
                strFilename = olkAttachment.FileName
                intCount = 0
                Do While True
                    If objFSO.FileExists(varFolder & strFilename) Then
                        intCount = intCount + 1
                        strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                    Else
                        Exit Do
                    End If
                Loop
                olkAttachment.SaveAsFile varFolder & strFilename
            Next
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Sub SaveAttachmentsToDiskRuleFXIP1A(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\Fixing Centa FXIP Index Report\FXIP1\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Sub SaveAttachmentsToDiskRuleFXIP2(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\Fixing Centa FXIP Index Report\FXIP2\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Sub SaveAttachmentsToDiskRuleFXIP3(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\Fixing Centa FXIP Index Report\FXIP3\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub
Sub SaveAttachmentsToDiskRuleDailyManagerReport(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\Fixing Centa FXIP Index Report\AlphaSelectTrading\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

Screenshot.png
0
 
David LeeCommented:
Hi, Chris.

I've run into this same issue when migrating Outlook's code file from one version of Office to another.  Here's what I recommend.

1.  Close Outlook.

2.  Make a backup copy of Outlook's code file.  The file name is VbaProject.OTM.  On a Win7 computer you'll find the file in the c:\Users\<username>\AppData\Roaming\Microsoft\Outlook folder.

3.  Delete the original code file.

4.  Start Outlook.  

5.  Open the VB editor by pressing ALT+F11.  Outlook will create a new, empty code file.

6.  Add the code from the question.

You should be in business.  
0
 
CC10Author Commented:
Hi there,

I have tried that as well as reinstalling Office enterprise 2007 but still get the same error message. I deleted the VBA project and started a new one with a new module and then copied in the macro.
I am wondering whether it has anything to do with Exchange server.

Chris
0
 
David LeeCommented:
Is it still dying on the same line with the same error message?
0
 
CC10Author Commented:
Yes
0
 
CC10Author Commented:
I opened a new profile with a different email address, rewrote the rule and reinstalled the macro. The rule works, as in the other profile, but this time the script does not run at all. i.e. no error message,

Very strange!
0
 
David LeeCommented:
Macros probably aren't enabled.  

0
 
CC10Author Commented:
I ran the rule again this morning and this time I got the same error message. The macros are active.  So creating a new profile did not solve the problem.
0
 
David LeeCommented:
Does the folder exist and is the path to is spelled correctly in the macro?
0
 
CC10Author Commented:
This is the path defined in the macro

Const FOLDER_PATHS = "C:\Fixing Centa FXIP Index Report\FXIP1\,C:\Users\centa\Dropbox\Centa\FXIP1\"


Below is the actual folder.  I think the path is correct. Folder description
0
 
CC10Author Commented:
SOLVED IT! so simple that it took me a week to find the solution. in VB, tools, references, untick the MISSING box.
0
 
CC10Author Commented:
partial answer
0
 
CC10Author Commented:
partial answer
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 10
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now