VBA to Save CSV Attachment to harddrive when email is received into Inbox

I am working on an Outlook VBA procedure to save the CSV attachment of an email with a specific subject text when the email is received into the Inbox.  So far, I have a rule set to run a script when the email with the subject text is received.  What I am finding is that the rule identifies the email properly and fires the VBA script but the email has not actually entered the Inbox so the VBA runs to completion and nothing is saved, then the email appears in the Inbox.   If I run the VBA manually once the email is in the inbox it saves the CSV to the proper location.

In the same routine, I would like to move the email to a subfolder (“Executive_Dashboard” in this case) after the attachment has been saved to the network location.

We use Outlook as the client with Google g-Mail as the backend mail server.  We do not have an Exchange environment.   I am primarily an Excel person and only have a limited understanding of the Outlook object model so please be specific if you can.   Through research I have read about NewMailEx and AddItem as possible solution but I don’t fully understand the concepts.

My first attempt is below.   If there  is a better way I am more than willing to trash what I have and go with a better solution.

Many Thanks,
Sub MoveDashboardAttachments(Item As Outlook.MailItem)

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Atmt As Attachment
Dim SubFolder As MAPIFolder
Dim FileName As String
Dim olCurrMailItem As MailItem
Dim d As Integer
Dim intUwv As Integer
Dim intWv As Integer
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Dashboard_Executive")

i = 0
For Each Item In Inbox.Items
    d = DateDiff("d", CDate(Item.ReceivedTime), CDate(Now()))
    If d <= 5 Then
        'identify which email is being processed by looking at the email-subject
        intUwv = InStr(1, Item.Subject, "Attachment Test", 1)
        intWv = InStr(1, Item.Subject, "Attachment Testing", 1)
        ' if one of the emails is identified then process the email attachments
        If intUwv + intWv > 0 Then
            For Each Atmt In Item.Attachments
                If Right(Atmt.FileName, 3) = "csv" Then
                    FileName = "\\FLFILE01\Warehouse\Data\Jerry\" & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    Item.Move SubFolder
                    i = i + 1
                End If
            Next Atmt
            intUwv = 0
            intWv = 0
        End If
    End If
Next Item
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
End Sub

Open in new window

LVL 16
Jerry PaladinoAsked:
Who is Participating?
Rgonzo1971Connect With a Mentor Commented:

As script pls try

Public Sub saveCSVAttach(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
d = DateDiff("d", CDate(itm.ReceivedTime), CDate(Now()))

If d <= 5 Then
    intUwv = InStr(1, itm.Subject, "Attachment Test", 1)
    intWv = InStr(1, itm.Subject, "Attachment Testing", 1)
    If intUwv + intWv > 0 Then
        For Each objAtt In itm.Attachments
            If objAtt.FileName Like "*.csv" Then
                FileName = "\\FLFILE01\Warehouse\Data\Jerry\" & objAtt.FileName
                objAtt.SaveAsFile FileName
                Set objAtt = Nothing
            End If
    End If
End If

End Sub

Open in new window

Why don't you try to use the rule to filter by  the subject text and to move the mail to the desired folder

Jerry PaladinoAuthor Commented:

Works perfect.   I appreciate your help.
Thank You,
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.