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