Question : 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 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

Answer : Auto Save Email Attachemnt to local disk by Outlook 2003

That's because of the Option Explicit statement at the top.  Either remove it or add this

    Dim strCommand, objShell
Random Solutions  
 
programming4us programming4us