Auto-Save Attachment does not download the attachment - vba

Question

can someone advise what have I done wrong on here? It is not picking up the emails the way it should (i.e. automatically download the attachments into a folder). There is no error messages, but simply no action (I went F8 but would not notice any irregularities).
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "test123#gmail.com") And _
(Msg.Subject = "Test123") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "C:\Test\Test1\"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Also, when I'm trying to F8 for errors, the VBA only goes through the first part of the code i.e. Private Sub Application_Startup(), I'm unable to test the other part {Private Sub Items_ItemAdd(ByVal item As Object)} cos the VBA simply denies going through it line by line (no error pop-ups or anything, it simply is not picking up the lines)

Answer 1

The problem is in the line
myAttachments.item(1).SaveAsFile attPath & Att
You are always picking attachment no 1, which might be something else than you think. Add a For Each around this, and you'll hopefully get some better results.

Answer 2

My guess is that your problem is this condition:
If (Msg.SenderName = "test123#gmail.com")
The MailItem.SenderName property returns the display name of the sender, which may not be the actual email address. You should be checking the MailItem.SenderEmailAddress property instead.
If the email you're trying to match is an Exchange address (ie, it's from someone in your office's Outlook account), the MailItem.SenderEmailAddress will return an incomprehensible string that you'll need to resolve to an actual email. In that case, you'd need to check the MailItem.Sender.GetExchangeUser().PrimarySmtpAddress property instead.
For that reason, I like to use an "emailMatches" function that checks both scenarios. Then your condition would be something like:
If emailMatches(Msg, "test123#company.com")
Here's the function I use:
Function emailMatches(mItem As Object, addressToMatch As String) As Boolean
Dim goAhead As Boolean
goAhead = False
If UCase(mItem.SenderEmailAddress) = UCase(addressToMatch) Then
goAhead = True
ElseIf Left(mItem.SenderEmailAddress, 5) = "/O=EX" Then
If UCase(mItem.Sender.GetExchangeUser().PrimarySmtpAddress) = UCase(addressToMatch) Then
goAhead = True
End If
End If
emailMatches = goAhead
End Function