Solved auto save all the attachments from outlook vba cod

January 4, 2016 at 03:49:58
Specs: Windows 7
looking for code which can save all the attachments as and when received from outlook which has a specific subject as "test". Create a folder by current day and suffex current date and time for each attachment which has been saved. Found few links on however i need this to be automatically saved

http://excel-macro.tutorialhorizon....


See More: auto save all the attachments from outlook vba cod

Report •

#1
January 7, 2016 at 02:02:33
✔ Best Answer
Please try this code, what it does is:

1) Looks for new email in outlook
2) Checks subject line for 'Test' (you can change this to whatever you need)
3) Created a folder with todays day name eg 'Thursday'
4) Saves each attachment with the name and time surfixed

You will need to do the following:

1) Open Outlook
2) Press and hold ALT and tap F11 to open the VBE
3) Double click on 'ThisOutlookSession' in project explorer
4) Paste the code

Note you will need to modify the path letter 'P:\' to wherever you want to save the attachments, there are 3 places to change this within the 'items_itemsAdd function.

Note once you paste the code, please save and close Outlook, then reopen it, the code needs to initialise some variables in order to work, this is done when Outlook is launched.

Private WithEvents Items As Outlook.Items

Dim iExt As String

Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
    
    Dim TimeDateString As String

    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
    
    
    ' ******************
     If Msg.Subject = "Test" Then
     
        TimeDateString = Format(Now(), "ddmmyyyy hhmmss")
     
        If Dir("P:\" & TodaysDay, vbDirectory) = vbNullString Then
            
            MkDir ("P:\" & TodaysDay)
            
        End If
        
        
        Dim myatt As Attachment

        For Each myatt In Msg.Attachments
        
            Dim FolderPath As String
        
            FolderPath = "P:\" & TodaysDay
                
        
            myatt.SaveAsFile FolderPath & "\" & TrimedFileName(myatt.FileName) & " " & TimeDateString & iExt
                        
            
        Next myatt

 End If
    ' ******************
  
  
  End If
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Function TodaysDay() As String
    
    Dim TheDay As Integer
    
    TheDay = Weekday(Format(Now(), "dd/mm/yyyy"))
    
    Select Case TheDay
        
        Case 1:
            
            TodaysDay = "Sunday"
        
        Case 2:
            
            TodaysDay = "Monday"
            
        Case 3:
            
            TodaysDay = "Tuesday"
            
        Case 4:
            
            TodaysDay = "Wednesday"
            
        Case 5:
            
            TodaysDay = "Thursday"
            
        Case 6:
            
            TodaysDay = "Friday"
            
        Case 7:
            
            TodaysDay = "Saturday"
            
    End Select
            
    
End Function
  
Public Function TrimedFileName(nName As String) As String
    
    Dim nLen As Integer
    Dim endLen As Integer
    
    Dim ExtLen As Integer
         
    nLen = Len(nName)
           
    For i = nLen To 1 Step -1
            
        ExtLen = ExtLen + 1
            
        If Mid(nName, i, 1) = "." Then
            endLen = i - 1
            iExt = Mid(nName, i, ExtLen)
            Exit For
        End If
        
    Next i
    
    TrimedFileName = Mid(nName, 1, endLen)
    
    endLen = 0
    nLen = 0
    
End Function


Report •

#2
January 7, 2016 at 03:48:20
what happens for next week I mean if its next Thursday will it replace the current file?

Report •

#3
January 7, 2016 at 04:06:25
thats a good question it probably will overwrite the original - but considering that the filename also had the time within it, hh:mm:ss it will be difficult for the filenames to be exactly the same, especially considering the seconds of the time, it is not impossible, but unlikely..

Report •
Related Solutions


Ask Question