Macro to Save Outlook attachment to a specific folder

[Alvinpereira]

Hi,

I've got part of the code but it doesn't seem to work and I Don't understand why.

The following is my requirement:-

I need a code that allows a user to select the folder which he needs in outlook ( Say Inbox, Sent items etc)
Then it should search all mails received on a particular date ( preferably an input box for them to type in the date) for the subject which contains "Performance Cards"
And then save it to a folder which I specify.. say a new folder on the desktop.

Can some one please help me with this?

PFB the current code.
------------------------------------------------------------------------------------------------------------------------------
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

saveInFolder = "C:\Users\alvin.pereira\Desktop\New 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 = "*Performance Card*" ' "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.Folders("Personal Folders").Folders("Inbox") '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

 

[Alvinpereira]

Anyone Can Help me with this please?

 

[Norie]

This code, run from Outlook, will display a dialog with all the mail folders and allow the user to pick one.

Sub FolderPick()

    Dim objNS As NameSpace
    Dim objFolder As Folder

    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder

    If TypeName(objFolder) <> "Nothing" Then
        Debug.Print vbCr & " objFolder: " & objFolder
    Else
        Debug.Print vbCr & "Cancel"
    End If

    Set objFolder = Nothing
    Set objNS = Nothing

End Sub

You'll need to adapt it to run from Excel, which should be straightforward but if you have any trouble post back and I'll take a look.

PS You would basically replace Application with outApp and qualify NameSpace and Folder, something like this.

Sub FolderPick()
Dim objOutlook As Object
Dim objNS As Object    ' Namespace
Dim objFolder As Object    ' Folder

    Set objOutlook = CreateObject("Outlook.Application")

    Set objNS = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder

    If TypeName(objFolder) <> "Nothing" Then
        Debug.Print vbCr & " objFolder: " & objFolder
    Else
        Debug.Print vbCr & "Cancel"
    End If

    Set objFolder = Nothing
    Set objNS = Nothing

End Sub

 

[Alvinpereira]

Hi Norie,

Thanks for the code.

How do i input a code so that vba searches only for mail received on a particular date? or a range of dates..

Can you help me with that please?

Thanks,
Alvin

 

[Norie]

Alvin

Can't you just test the received dates of the mail items as you loop through them?

If an email is received on a specific date, or within a particular date range, then process it.

 

[Alvinpereira]

I'm confused here, i can find an option which says received-time, isn't there an option which checks received date?

 

[Norie]

As far as I'm aware ReceivedTime includes the date and time.