Download & Move Attachments

[zmagic]

Hi,

With this script i am already downloading and saving the particular files to my hard drive, now i have some more attachment to be downloaded but i want them to be saved to different folder on my hard drive, Help me to do this which will ease my work of moving files from one place to another. File name is COJ12991 to D:\Soft

Sub GetAttachments_From_Inbox()   
   On Error GoTo GetAttachments_err
   Dim appOl As New Outlook.Application
   Dim ns As Outlook.NameSpace
   Dim Inbox As Outlook.MAPIFolder
   Dim myDestFolder As Outlook.MAPIFolder
   Dim Item As Object
   Dim Atmt As Outlook.Attachment
   Dim FileName As String
   Dim i As Integer
   Dim iLoop As Integer
   Dim sender As String
   Dim bankName As String
   Dim ext As String
   Dim Items As Outlook.Items
   Dim oc As Object
   Dim moveEmail As Boolean
   Set ns = appOl.GetNamespace("MAPI")
   Set Inbox = ns.GetDefaultFolder(olFolderInbox)
   Set Item = Inbox.Items
   Set myDestFolder = Inbox.Folders("Personal Mail")
   i = 0
   iLoop = 0
   If Inbox.Items.Count = 0 Then 
 
'       ' MsgBox "There are no messages in the Inbox.", vbInformation, _
       "Nothing Found"
       Exit Sub
   End If
   For iLoop = 1 To Inbox.Items.Count
       For Each Item In Inbox.Items
           moveEmail = False
           For Each Atmt In Item.Attachments
                If UCase(Atmt.FileName) Like "Export*" Or _
               UCase(Atmt.FileName) Like "Report*" Or _
               UCase(Atmt.FileName) Like "Update" Or _
               UCase(Atmt.FileName) Like "Sales*" Or _
        FileName = "D:\Attachments\" & Atmt.FileName
                   Atmt.SaveAsFile FileName
                   moveEmail = True
                   i = i + 1
               End If
           Next Atmt
           If moveEmail Then
               Item.Move myDestFolder
           End If
       Next Item
       iLoop = iLoop + 1
   Next   
        If i > 0 Then
       'MsgBox "I found " & i & " attached files." _
       & vbCrLf & "I have saved them into the D:\Attachments folder." _
       & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
   Else
      ' MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
   End If 
 
GetAttachments_exit:
   Set Atmt = Nothing
   Set Item = Nothing
   Set ns = Nothing
   Set appOl = Nothing
   Exit Sub 
 
GetAttachments_err:
   'MsgBox "An unexpected error has occurred." _
   & vbCrLf & "Please note and report the following information." _
   & vbCrLf & "Macro Name: GetAttachments" _
   & vbCrLf & "Error Number: " & Err.Number _
   & vbCrLf & "Error Description: " & Err.Description _
   , vbCritical, "Error!"
   Resume GetAttachments_exit 
 
End Sub

 

[Diane Poremsky]

This is where you set the Windows folder: "D:\Attachments\" & Atmt.FileName - you just need to change the path.