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

Posted on 2014-03-12
Last Modified: 2014-03-12
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

Question by:Jerry Paladino
LVL 49

Accepted Solution

Rgonzo1971 earned 500 total points
ID: 39923605

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

LVL 16

Author Closing Comment

by:Jerry Paladino
ID: 39923742

Works perfect.   I appreciate your help.
Thank You,

Featured Post

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
Having trouble getting your hands on Dynamics 365 Field Service or Project Service trial? Worry No More!!!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question