Download Email attachment from outlook

[abhay_547]

I got the below macro for downloading attachements from outlook based on specific subject line but when I am trying to define the folder name as string by referring the folder name from a worksheet cell it's not working. can someone advise what could be going wrong over here...

Public Sub Extract_Outlook_Email_Attachments()

    Dim OutlookOpened As Boolean
    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outAttachment As Outlook.Attachment
    Dim outItem As Object
    Dim outMailItem As Outlook.MailItem
    Dim inputDate As String, subjectFilter As String
    Dim saveInFolder As String
    Dim OutlookPersonalFolder As String
    
    OutlookPersonalFolder = ThisWorkbook.Sheets(Sheet1).Range (E4).value






    saveInFolder = "C:\path\to\folder\"                                 'CHANGE FOLDER PATH AS NEEDED
    If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
    
    inputDate = InputBox("Enter date to filter the email subject", "Extract Outlook email attachments")
    If inputDate = "" Then Exit Sub
    
    subjectFilter = "Daily activities: " & Format(inputDate, "dd/mm/yyyy")
    
    'Get or create Outlook object and make sure it exists before continuing
    
    OutlookOpened = False
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set outApp = New Outlook.Application
        OutlookOpened = True
    End If
    On Error GoTo 0
    
    If outApp Is Nothing Then
        MsgBox "Cannot start Outlook.", vbExclamation
        Exit Sub
    End If
    
    Set outNs = outApp.GetNamespace("MAPI")
    
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders(OutlookPersonalFolder) 'CHANGE FOLDER AS NEEDED
    'Set outFolder = outNs.PickFolder                                   'OR USER SELECTS FOLDER




    If Not outFolder Is Nothing Then
        For Each outItem In outFolder.Items
            If outItem.Class = Outlook.OlObjectClass.olMail Then
                Set outMailItem = outItem
                If outMailItem.Subject = subjectFilter Then
                    Debug.Print outMailItem.Subject
                    For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile saveInFolder & outAttachment.Filename
                    Next
                End If
            End If
        Next
    End If




    If OutlookOpened Then outApp.Quit
    
    Set outApp = Nothing




End Sub

Also if the filename of the attachment is same without date and I want to overwrite the file in the folder everyday, how could I achieve the same. and the mail subject line is also same everyday with no date in subject line, so how can i make sure that the macro downloads the attachment from the latest email or today's email only and if the today's email is missing then it shows the msgbox that the today's mail is not available and exits the macro.

 

[Paul Ked]

Add quotes to E4 and remove the space

[COLOR=#333333] OutlookPersonalFolder = ThisWorkbook.Sheets(Sheet1).Range("E4").value[/COLOR]

 

[abhay_547]

Add quotes to E4 and remove the space

[COLOR=#333333] OutlookPersonalFolder = ThisWorkbook.Sheets(Sheet1).Range("E4").value[/COLOR]

Great. not sure how i missed those quotes. thanks. but if the filename of the attachment is same without date in naming convention then how will it overwrite the file in the folder everyday. and the mail subject line is also same everyday with no date mentioned in subject line, so how can i make sure that the macro downloads the attachment from the latest email or today's email only and if the today's email is missing then it shows the msgbox that the today's mail is not available and exits the macro. also if i have list in the excel which consists of email subject line and attachment name and outlook folders name, how can i loop through it.

 

[abhay_547]

Great. not sure how i missed those quotes. thanks. but if the filename of the attachment is same without date in naming convention then how will it overwrite the file in the folder everyday. and the mail subject line is also same everyday with no date mentioned in subject line, so how can i make sure that the macro downloads the attachment from the latest email or today's email only and if the today's email is missing then it shows the msgbox that the today's mail is not available and exits the macro. also if i have list in the excel which consists of email subject line and attachment name and outlook folders name, how can i loop through it.

Can anyone help with this.

 

[abhay_547]

Can anyone help with this.

 

[horseyride]

I usually filter for unread items, and just make sure the items I want to import are marked unread

Set olFolder = olNs.GetDefaultFolder(6).Folders("Foldername")     ' 6 =Inbox
Filter = "[Unread] = True"
Set Items = olFolder.Items.Restrict(Filter)