VBA Macro - Save .csv from Outlook and import into excel

[LNG2013]

Hi I receive a daily report via email as a csv file. I need help with a macro that everyday at 6am will pull the .csv files from the email rename them and put them in a specific folder. Then append a small database with the new data named Data.csv. It would all be in the same folder.

 

[s.ridd]

Hi, quite a long process this one.

Start off by placing this code in a module within Outlook

Public Sub ExportFile(MyMail As MailItem)

Dim outNS As Outlook.NameSpace
Dim outFolder As oulook.MAPIFolder
Dim outItem As Outlook.Object
Dim outNewMail As Outlook.MailItem
Dim strDir As String


    Set outNS = GetNamespace("MAPI")
    Set outFolder = outNS.GetDefaultFolder(olFolderInbox)
    Set outNewMail = outFolder.Items.GetLast
    
    strDir = "C:\" 'insert directory eg. "C:\Project\OutlookData"
    If outNewMail.Attachments.Count = 0 Then GoTo Err
    outNewMail.Attachments(1).SaveAsFile strDir & "Data.csv"


Dim accApp As Access.Application
    
    Set accApp = New Access.Application
    
    accApp.OpenCurrentDatabase strDir '& insert database name eg. Database1.acddb
    accApp.DoCmd.RunSavedImportExport ("Import1")
    accApp.DoCmd.OpenQuery ("Qry01_Append_Data")
    
    accApp.Quit
    
    Set accApp = Nothing
    Set outNewMail = Nothing
    Set outFolder = Nothing
    Set outNS = Nothing
    
Err:
    Set outFolder = Nothing
    Set OuNewMail = Nothing
    Set outNS = Nothing
    
End Sub

Now within outlook click Tools>Rules and Alerts and then New Rule and choose "Start from a blank rule"> "Check messages when they arrive". On Step 1 choose the rules that suit your daily email such as a specific sender or subject and then on rule 2 choose "run a script" and then in the "Edit the rule description" box on the hyperlink choose the ExportFile macro which you just copy and pasted. In the Step 3 screen add any exclusions you want and finally give your rule an appropriate name.

Moving onto Access. Create a new database (or move your existing one into the relevant directory) and import a file from your directory called "Data.csv" and do whatever steps you have to to import the file the correct way. Once you've finished importing click the "save import steps" check box and give the import routine a sensible name ("Import1" in my example). If you don't hyet have an append query set up then create one and call the query something relevant ("Qry01_Append_Data" in my example).

Almost finished, now go back to the VBA Editor in Outlook and specify the directory in the strDir variable and change the following code to match what you've created

    accApp.OpenCurrentDatabase strDir '& insert database name eg. Database1.acddb    accApp.DoCmd.RunSavedImportExport ("Import1")
    accApp.DoCmd.OpenQuery ("Qry01_Append_Data")

And hopefully tomorrow at 6am the process should work. You can test this in the meantime by editing your rule (or creating a new one) to accept emails coming from your email address and simply attach the data.csv file to the email.

Note - this assumes that you are happy to overwrite the Data.csv file each day. It also assumes you meant a database and not an excel file. If you meant Excel then let me know and I'll amend the code accordingly.

Hope it is of some help

Simon

 

[s.ridd]

Now that I've bothered to read the title I notice it explicitly says Excel. My preference would still be to use Access, even if you ran an export to Excel.

However, this should do the job in Excel for you. I forgot to mention before, you need to set a reference to the Excel (this time) Object library by clicking Tools>References and choosing Microsoft Excel x Object Library from the VBE in Outlook.

Public Sub ExportFile(MyMail As MailItem)

Dim outNS As Outlook.NameSpace
Dim outFolder As oulook.MAPIFolder
Dim outNewMail As Outlook.MailItem
Dim strDir As String


    Set outNS = GetNamespace("MAPI")
    Set outFolder = outNS.GetDefaultFolder(olFolderInbox)
    Set outNewMail = outFolder.Items.GetLast


    strDir = "C:\" 'insert directory eg. "C:\Project\OutlookData\"

    If outNewMail.Attachments.Count = 0 Then GoTo Err
    outNewMail.Attachments(1).SaveAsFile strDir & "Data.csv"


Dim xlApp As Excel.Application
Dim xlWbk1 As Excel.Workbook
Dim xlWbk2 As Excel.Workbook


    Set xlApp = New Excel.Application
    xlApp.DisplayAlerts = False
    
    xlApp.Workbooks.Open strDir & "Data.csv"
    xlApp.Workbooks.Open strDir & "Master.xlsb"
    
    Set xlWbk1 = xlApp.Workbooks("Data.csv")
    Set xlWbk2 = xlApp.Workbooks("Master.xlsb")
    
    xlWbk1.Sheets(1).UsedRange.Copy Destination:=xlWbk2.Sheets(1).Cells(Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1)
    
    xlWbk2.Save
    xlApp.DisplayAlerts = True
    xlApp.Quit
    
    Set xlWbk2 = Nothing
    Set xlWbk1 = Nothing
    Set xlApp = Nothing
    
    Set outNewMail = Nothing
    Set outFolder = Nothing
    Set outNS = Nothing


Err:
    Set outFolder = Nothing
    Set OuNewMail = Nothing
    Set outNS = Nothing
    
End Sub

Hopefully this is closer to what you wanted

Simon