Link to home
Start Free TrialLog in
Avatar of rowfei
rowfei

asked on

Auto Save Email Attachemnt to local disk by Outlook 2003

I find the following codes to auto save the email attachment to local disk, but for some reason, the codes doesn't work. Please Help.

' How to use:
' From Outlook, open the VBEditor (Alt+F11)
' Add a reference to the "Microsoft Excel <your version number> Object Library fron Tools>References
' Paste the code into the ThisOutlookSession module
' Create an Outlook folder named "Temp" in your Personal folders (or amend the code: Set TargetFolderItems to eqaul an existing folder)
' Create a directory "C:\Temp" (or amend the constant: FILE_PATH to eqaul an existing folder)
' Save the project
' Restart Outlook (or run the routine "Application_Startup")

' Testing the vba script
' Move a mail item with some attachments into you target folder.
' The attachments will be saved in your specified directory
' Any Excel files will be printed




 '###############################################################################
 '### Module level Declarations
 'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
 'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"
 
 '###############################################################################
 '### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
     'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace
     '
    Set ns = Application.GetNamespace("MAPI")
    Set TargetFolderItems = ns.Folders.Item( _
    "Personal Folders").Folders.Item("Temp").Items
     
End Sub
 
 '###############################################################################
 '### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
     'when a new item is added to our "watched folder" we can process it
    Dim olAtt As Attachment
    Dim i As Integer
     
    If Item.Attachments.Count > 0 Then
        For i = 1 To Item.Attachments.Count
            Set olAtt = Item.Attachments(i)
             'save the attachment
            olAtt.SaveAsFile FILE_PATH & olAtt.FileName            
            End If
        Next
    End If
     
    Set olAtt = Nothing
     
End Sub
 
 '###############################################################################
 '### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()
     
    Dim ns As Outlook.NameSpace
    Set TargetFolderItems = Nothing
    Set ns = Nothing
     
End Sub
Avatar of David Lee
David Lee
Flag of United States of America image

Hi, rowfei.

Try this.  I cleaned it up and eliminated some unecessary code.  This code must go in the ThisOutlookSession module.
Option Explicit
Dim WithEvents TargetFolderItems As Outlook.Items
'Set FILE_PATH on the following line to the path you want to save the attachments to.  Make sure it ends with a \
Const FILE_PATH As String = "C:\Temp\"
 
Private Sub Application_Startup()
    'Change the folder path on the line below to point to the folder you want to monitor
    Set TargetFolderItems = Session.Folders.Item("Personal Folders").Folders.Item("Temp").Items
End Sub
 
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
    'When a new item is added to our "watched folder" we can process it
    Dim olAttachment As Outlook.Attachment
    For Each olAttachment In Item.Attachments
        'Save the attachment
        olAttachment.SaveAsFile FILE_PATH & olAttachment.FILENAME
    Next
    Set olAttachment = Nothing
End Sub
 
Private Sub Application_Quit()
    Set TargetFolderItems = Nothing
End Sub

Open in new window

Avatar of rowfei
rowfei

ASKER

I tried the codes but still doesn't work. After I move a email with excel attachment to Temp personal folder and nothing appears in Temp folder that in C drive.
The code works, I tested it before posting.  Something is not set up right on your computer.  Let's check these things.

1.  Is Outlook security set to allow macros to run?  Click Tools > Macro > Security and make sure it is set to at least Medium.

2.  Is all the code in the module named ThisOutSession?

3.  Did you close and restart Outlook after adding the code?  If not, do so.

When Outlook starts you should get a prompt saying that ThisOutlookSession contains macros and asking if you want to enable them.  You have to say yes.
Avatar of rowfei

ASKER

I did what you recommend. I get an error message "Run-time error '-163827697(9cd4010f), The operatiuon failed. An object could not be found." After I restart the outlook and enable the macro.

If I click OK the yellow high the line 8 " Set TargetFolderItems = Session.Folders.Item("Personal Folders").Folders.Item("Temp").Items"

That means the folder path is wrong.  What folder is it that you want to monitor and where is it in the folder hierarchy?
Avatar of rowfei

ASKER

Thank you so much, BlueFan. I put the wrong personal folder.
Can I have one more question? I would like call another VBScript after the attachment is moved to local disk. What codes should I add to ThisOutSession?
VBScript or VBA?  They're different things.  VBA runs from inside Outlook.  VBScript would be an external file.
Avatar of rowfei

ASKER

I would like to call a VBScript that I wrote after the attachement is saved in local disk. So is any vba that I can add in to call a VBScript?

Thanks
The best means of running an external VBScript is to use the Shell object.  Something like the code fragment below.  You can place it wherever you need to in the VBA code.
strCommand = "WScript.exe C:\SomeFolder\Scriptname.vbs"
Set objShell = CreateObject("WScript.Shell")
'True on the following line tells VBA to wait until the script completes (synchronus execution).  If you don't want to wait, then change it to False (ascynchronus execution).
objShell.Run strCommand, 0, True

Open in new window

Avatar of rowfei

ASKER

Thanks BlueFan.

I would like to know how to overwrite the file if I save the attachment?

It will overwrite the file now if it exists.  No changes required.
Avatar of rowfei

ASKER

Hi BlueFan,

I put the following runing vbs after Set olAttachment = Nothing, then I got the Complile error: Variable not defined.

strCommand = "WScript.exe C:\SomeFolder\Scriptname.vbs"
Set objShell = CreateObject("WScript.Shell")
'True on the following line tells VBA to wait until the script completes (synchronus execution).  If you don't want to wait, then change it to False (ascynchronus execution).
objShell.Run strCommand, 0, True
 
ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America 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 rowfei

ASKER

Thank you so much, BlueFan.

If I would like to add a warning message before running the external VBScript, such as " Report is generating now, Please click "NO" if you would like to cancel it."   If users don't click no button in 3 seconds, then external VBScript is going to be run.
 Thanks again.
You're welcome.  Sorry, that's going to have to be an additional question.  
Avatar of rowfei

ASKER

Ok, I will open a new question. Thanks again.
No problem.  Glad I could help.