Outlook 2010 VBA to download csv file from an email

[craigmajors]

I am using Outlook 2010 Windows 7 OS. I am novice in using VBA and most of the code below is from doing searches and copying and pasting the code and changing it to suit my specific needs.

I have an email that is sent me twice daily that has a link to download a .csv file. The csv file is usually a string or random numbers and I am saving it as DailyInbound.csv and linking that to a database. I have been downloading the file manually and would like to try and automate the process.

I have included the code that I have tried to use. I have linked the "CHRobDL" to an Outlook rule that triggers when the email is received.
It downloads the file to my downloads folder and then moves it to a folder on the server and renames it as "DailyInbound.csv"

Everything works correctly if the email with the link is open. If it is not open it will fail at "Set msg = ActiveInspector.CurrentItem"

Thank you in advance for any help and let me know if you need any more information.



Public FileName As String
Public NewLocation, OldLocation As String
Public MostRecentFile As String

Public Sub CHRobDL(Item As Outlook.MailItem)
Call HyperlinkAddress
End Sub


Sub HyperlinkAddress()
'Item As Outlook.MailItem

Dim msg As Object
Dim oDoc As Object
Dim h As Object
'Dim OldLocation As String
'Dim NewLocation As String

'Change Username below for each PC.
OldLocation = "C:\users\majorsc\downloads"
NewLocation = "\\INEPRWF02\IE_Inventory\Databases\DailyInbound\DailyInbound.csv"


Set msg = ActiveInspector.CurrentItem


If msg.GetInspector.EditorType = olEditorWord Then

Set oDoc = msg.GetInspector.WordEditor

For Each h In oDoc.Hyperlinks
Debug.Print "Displayed text: " & h.TextToDisplay & vbCr & " - Address: " & h.Address
h.Follow
Next

End If

Set msg = Nothing
Set oDoc = Nothing
Set h = Nothing

Call NewestFile(OldLocation, "*.csv")
Call DeleteOldFile
Call Rename
End Sub

Function NewestFile(Directory, FileSpec)
' Returns the name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
'Dim FileName As String
'Dim MostRecentFile As String
Dim MostRecentDate As Date
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"

FileName = Dir(Directory & FileSpec, 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
NewestFile = MostRecentFile
Debug.Print NewestFile

End Function




Function Rename()

'OldName = OldLocation: NewName = NewLocation
Name OldLocation & MostRecentFile As NewLocation
' Move and rename file.

End Function




Function DeleteOldFile()

' Old DailyInbound.csv file
'Kill NewLocation

If Len(Dir$(NewLocation)) > 0 Then
Kill NewLocation
End If



End Function

[skatonni]

There must be a use for Item As Outlook.MailItem. It is the mail that is being received. Pass it along.


Public Sub CHRobDL(Item As Outlook.MailItem)
Call HyperlinkAddress_with_parameter (Item)
End Sub


Sub HyperlinkAddress_with_parameter (msg as mailitem)
'Item As Outlook.MailItem

'Dim msg As Object
Dim oDoc As Object
Dim h As Object
'Dim OldLocation As String
'Dim NewLocation As String

'Change Username below for each PC.
OldLocation = "C:\users\majorsc\downloads"
NewLocation = "\\INEPRWF02\IE_Inventory\Databases\DailyInbound\DailyInbound.csv"


'Set msg = ActiveInspector.CurrentItem

' rest is the same

Unless there is some reason to go through Public Sub CHRobDL you can just set HyperlinkAddress_with_parameter to work directly with the rule.