Dwonload attachment from specific sender and open in excel - vba

Question

I am rather new to VBA and was hoping to get some help on a project. To give you some background, I get an email in outlook about every 15 minutes with an excel attachment. I need to open the attachment once the email gets in and view it / compare it to the email that was sent 15 minutes prior. If there is a difference in the emails then I must preform an action. I was hoping to automate at least some of this process. Ideally, I could use a macro to scan my inbox for any new message from a particular sender. If it finds a message it could then check for an attachment and if the attachment is there it would download and open it.
In an ideal world the other thing I could do is compare the prior excel attachment to the current one and ping a message (alert) if it is different.
Any help would be much appreciated. As I said, I am new to VBA but I am trying my best to understand functions.

Answer 1

This should get you started. Assuming you have selected the e-mail in outlook:
Sub check_for_changes()
'Created by Fredrik Östman www.scoc.se
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = myOlApp.Explorers.Item(1)
Set myOlSel = myOlExp.Selection
Set mymail = myOlSel.Item(1)
Dim myAttachments As Outlook.Attachments
Set myAttachments = mymail.Attachments
Dim Atmt As Attachment
Set Atmt = myAttachments(1)
new_file_name = "C:\tmp\new_received_file.xlsx"
old_file_name = "C:\tmp\old_received_file.xlsx"
FileCopy new_file_name, old_file_name
Atmt.SaveAsFile new_file_name
Dim eApp As Object
Set eApp = CreateObject("Excel.Application")
eApp.Application.Visible = True
Dim new_file As Object
eApp.workbooks.Open new_file_name
Set new_file = eApp.ActiveWorkbook
Dim old_file As Object
eApp.workbooks.Open old_file_name
Set old_file = eApp.ActiveWorkbook
'Find range to compare
start_row = old_file.sheets(1).usedrange.Row
If new_file.sheets(1).usedrange.Row > start_row Then start_row = new_file.sheets(1).usedrange.Row
end_row = old_file.sheets(1).usedrange.Row + old_file.sheets(1).usedrange.Rows.Count
If new_file.sheets(1).usedrange.Rows.Count + new_file.sheets(1).usedrange.Row > end_row Then end_row = new_file.sheets(1).usedrange.Rows.Count + new_file.sheets(1).usedrange.Row
start_col = old_file.sheets(1).usedrange.Column
If new_file.sheets(1).usedrange.Column > start_col Then start_col = new_file.sheets(1).usedrange.Column
end_col = old_file.sheets(1).usedrange.Column + old_file.sheets(1).usedrange.Columns.Count
If new_file.sheets(1).usedrange.Columns.Count + new_file.sheets(1).usedrange.Column > end_row Then end_row = new_file.sheets(1).usedrange.Columns.Count + new_file.sheets(1).usedrange.Column
'Check all cells
something_changed = False
For i = start_row To end_row
For j = start_col To end_col
If new_file.sheets(1).Cells(i, j) <> old_file.sheets(1).Cells(i, j) Then
new_file.sheets(1).Cells(i, j).Interior.ColorIndex = 3 'Mark red
something_changed = True
End If
Next j
Next i
If something_changed Then
new_file.Activate
Else
new_file.Close
old_file.Close
If eApp.workbooks.Count = 0 Then eApp.Quit
MsgBox "No changes"
End If
End Sub

Answer 2

Interesting question, I'll get you started with the outlook part. You'll probably want to split the question between Outlook and Excel.
Here is some code I use to save every attachment I have been sent in Outlook to save space.
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim pobjMsg As Outlook.MailItem 'Object
Dim objSelection As Outlook.Selection
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
For Each pobjMsg In objSelection
SaveAttachments_Parameter pobjMsg
Next
ExitSub:
Set pobjMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
MsgBox "Export Complete"
End Sub
Public Sub SaveAttachments_Parameter(objMsg As MailItem)
Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
' Get the path to your My Documents folder
strFolderpath = "C:\Users\******\Documents\Reports\"
'On Error Resume Next
' Set the Attachment folder.
strFolderpath = strFolderpath & "Outlook Attachments\"
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for removing items' from a collection. Otherwise, the loop counter gets' confused and only every other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName
If Right(strFile, 4) = ".png" Or Right(strFile, 4) = ".jpg" Or Right(strFile, 4) = ".gif" Then
GoTo cont
End If
' Combine with the path to the Temp folder.
strFile = strFolderpath & objMsg.SenderName & "." & Format(objMsg.ReceivedTime, "yyyy-MM-dd h-mm-ss") & "." & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment - You might not want this part
'objAttachments.Item(i).Delete
'write the save as path to a string to add to the message
'check for html and use html tags in link
If objMsg.BodyFormat = olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & Replace(strFile, " ", "%20") & ">"
Else
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & Replace(strFile, " ", "%20") & ">"
End If
cont:
Next i
' Adds the filename string to the message body and save it
' Check for HTML body
If objMsg.BodyFormat = olFormatHTML Then
objMsg.Body = "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
Else
objMsg.HTMLBody = "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.HTMLBody
End If
objMsg.Save
End If
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objOL = Nothing
End Sub
The part in the code which says
If Right(strFile, 4) = ".png" Or Right(strFile, 4) = ".jpg" Or Right(strFile, 4) = ".gif" Then
GoTo cont
you could change to something like:
If objMsg.SenderName = "John Smith" Then
GoTo cont
that way it will only save the attachment from that specific sender.
Then, once you have two or more files, you can load the files using another macro in excel and compare the two files, then send you an email if there are any discrepancies.
Hope that gets you started.