Good afternoon,
I'm new to VBA and access so I'll apologize in advance if my question is poorly worded.
I receive 24 x 12 emails per day with csv attachments that I would like to import into access databases automatically using VBA.
I've cobbled together code I found online (below) that works for files as received but1 - acts on previous message (as current message isn't displayed in the folder until the script is completed)
2 - requires my computer to be connected as all messages are received
As a result I would like to modify it to loop through all messages in a folder (AlgocanadaFuelToProcess); 1 - importing attachments
2 - moving the message to another folder(AlgocanadaFuelProcessed)
Can anyone help me do this?
I have to say, this is pretty amazing stuff!!
Thank you for taking the time to read my post,
Dave
___________
Public Sub ExportFileCanada(MyMail As MailItem)
Dim outNS As Outlook.NameSpace
Dim outFolder As Outlook.MAPIFolder
'Dim outItem As Outlook.Object
Dim outNewMail As Outlook.MailItem
Dim ns As NameSpace
Dim inb As Folder
Dim strDir As String
Dim fldr As Folder
Dim pfldr As Folder
Set outNS = GetNamespace("MAPI")
Set outFolder = outNS.GetDefaultFolder(olFolderInbox)
Set ns = Outlook.GetNamespace("MAPI")
Set inb = ns.GetDefaultFolder(olFolderInbox)
Set fldr = inb.Folders("_FuelReports")
Set fldr = fldr.Folders("Algocanada")
Set pfldr = fldr.Folders("AlgocanadaFuelProcessed")
Set fldr = fldr.Folders("AlgocanadaFuelToProcess")
Set outNewMail = fldr.Items.GetLast
strDir = "C:\FuelReporting\Algocanada" '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 & "Algocanada_2016.accdb" '& insert database name eg. Database1.acddb
accApp.DoCmd.RunSavedImportExport ("Algocanada")
' 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