Adding SendersEmailAddress

Question

This is my first post here at stackoverflow and I am having an issue where my syntax is only saving email attachments if the sender's domain is not from my company's domain (my company's domain i.e. info@mycompany.com) and only saving attachments that were received from yahoo, gmail, etc. How can I edit my code so that it saves all attachements regardless of domain?

 Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String
    
On Error Resume Next
Set OlApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

strFolder = "C:\Users\p00113357\Desktop\Attaches\"

Set OlFolder = OlApp.getnamespace("MAPI").Folders("EEO").Folders("Inbox").Folders("Incoming")

Set OlItems = OlFolder.Items

For Each OlMail In OlItems
    If OlMail.Attachments.Count > 0 Then
        For j = 1 To OlMail.Attachments.Count
            OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.SenderEmailAddress & OlMail.Attachments.Item(j).Filename
        Next j
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

MsgBox "Done", vbInformation

End Sub

---------------------------------update------------------------------------------

I included code to show my error and when I ran it, I did not see any error codes pop up. The issue of attachments from internal email domain (i.e. info@mycompany.com) not being downloaded to my designated folder while attachments from external email domains (yahoo, gmail etc) being downloaded is still happening. Below is my attempt to obtain error codes.

Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String

Set OlApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

**On Error GoTo 0
On Error Resume Next**
strFolder = "C:\Users\p00113357\Desktop\Attaches\"

Set OlFolder = OlApp.getnamespace("MAPI").Folders("EEO").Folders("Inbox")

Set OlItems = OlFolder.Items

For Each OlMail In OlItems

    If OlMail.Attachments.Count > 0 Then
        For j = 1 To OlMail.Attachments.Count
            OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.SenderEmailAddress & "-" & OlMail.Attachments.Item(j).Filename
        Next j
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

MsgBox "Done", vbInformation

End Sub

Thank you

---------------------------update---------------------------------------------

Following the directions in the post suggested by @notin I attempted to edit my code and it was still not working. I switched up the syntax a bit and it worked after placing lines of code in the correct order/places, thanks @notin and Josh P for your assistance with my first post. Moving forward, I will follow best practices when posting

Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String

Set OlApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

On Error GoTo 0
On Error Resume Next
strFolder = "C:\Users\p00113357\Desktop\Attaches\"

Set OlFolder = OlApp.getnamespace("MAPI").Folders("EEO").Folders("Inbox")

Set OlItems = OlFolder.Items

For Each OlMail In OlItems

    If OlMail.Attachments.Count > 0 Then
     If OlMail.SenderEmailType = "EX" Then
        For j = 1 To OlMail.Attachments.Count
                    OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.Sender.GetExchangeUser().PrimarySmtpAddress & "-" & OlMail.Attachments.Item(j).Filename
        Next j
     End If
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

MsgBox "Done", vbInformation

End Sub

You have it itm.SenderEmailAddress but I don't see anywhere in your example code where you have declared the itm object. Would it be OlMail.SenderEmailAddress? — Josh Pachner, Oct 09 '20 at 01:54
Hi Josh, what you suggested worked. My only issue now is that it is only saving attachments from domains such as hotmail, yahoo, aol, gmail etc and bypassing my companies email domain. Is there something in my code that is not allowing attachments from certain email domains to be saved? — rawdata, Oct 09 '20 at 02:17
Hey homie, FYI probably best practice not to change your question after receiving an answer. Just so people down the road when they come across your question the answers received makes sense. But in regards to your new question... Forget right now about looking for attachments. Can you see the emails sent from your domain when you are looking through your folder? Because if you can't see them at all then that explains why you wouldnt be able to save the attachments. — Josh Pachner, Oct 09 '20 at 03:33
Possible duplicate of [SenderEmailAddress property does not contain a standard email address for internal contacts](https://stackoverflow.com/questions/36900156/senderemailaddress-property-does-not-contain-a-standard-email-address-for-intern) — niton, Oct 09 '20 at 03:39
Josh, my sincere apologies, I completely understand , I was having difficulty reposting my syntax and new question but in the future I will not do this. Yes, I can so my inbox includes both emails sent from my colleagues and people outside of our organization, however, my code is only downloading the attachments from those outside my organization/company. Thanks again for your assistance. — rawdata, Oct 09 '20 at 03:40
@niton i looked this syntax over that you referenced me to and I am not sure I am going about it correctly unfortunately, I am not sure how to fix my code... — rawdata, Oct 09 '20 at 04:00
Consider `On Error GoTo 0` mandatory after `On Error Resume Next`. Place it just before `strFolder = "C:\Users\p00113357\Desktop\Attaches\"`. You will see any errors so you can fix them. If you cannot resolve then [edit] the question stating the error and showing your attempt to fix. — niton, Oct 09 '20 at 12:07

score 0 · Answer 1 · answered Oct 09 '20 at 14:45

SenderEmailAddress property does not contain a standard email address for internal contacts

If OlMail.SenderEmailType = "EX" then instead use OlMail.Sender.GetExchangeUser().PrimarySmtpAddress.

Option Explicit
            
Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String

Dim strPathFile As String


' This is a rare valid use of
On Error Resume Next
' Bypass expected error if Outlook is not open

Set OlApp = GetObject(, "Outlook.Application")

If err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

' Return to normal error handling to see unexpected errors
On Error GoTo 0


strFolder = "C:\Users\p00113357\Desktop\Attaches\"

Set OlFolder = OlApp.GetNamespace("MAPI").folders("EEO").folders("Inbox")

Set OlItems = OlFolder.Items

For Each OlMail In OlItems

    If OlMail.Attachments.Count > 0 Then
        
        ' The expectation is internal addresses will not have the @ type format
        '  instead the format will be similar to "/O=APPLE/CN=RECIPIENTS/CN=JOBSS6738"
        '  https://stackoverflow.com/questions/36900156/senderemailaddress-property-does-not-contain-a-standard-email-address-for-intern
        Debug.Print "OlMail.SenderEmailAddress: " & OlMail.SenderEmailAddress
        
        For j = 1 To OlMail.Attachments.Count
        
            ' Note the double backslash has no impact. Do not fix. Better to have two than none.
            Debug.Print strFolder & "\" & OlMail.SenderEmailAddress & "-" & OlMail.Attachments.Item(j).Filename
            
            ' If the SenderEmailAddress is in a format similar to "/O=APPLE/CN=RECIPIENTS/CN=JOBSS6738" then
            '   Error: "Cannot save the attachment. Path does not exist. Verify the path is correct."
            
            OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.SenderEmailAddress & "-" & OlMail.Attachments.Item(j).Filename
            
        Next j
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

MsgBox "Done", vbInformation

End Sub

I tried this using the OlMail.Sender.GetExchangeUser().PrimarySmtpAddress earlier and it was to no avail. I am just not sure I am placing the syntax in the correct areas. I also tried to run the code you sent and I received an error stating "cannot save the attachment, path doe not exist" I will edit my post to show modifications, thank you. — rawdata, Oct 09 '20 at 15:10
What does " it was to no avail" mean? Are you receiving an error? What is it? — Dmitry Streblechenko, Oct 09 '20 at 16:24

Adding SendersEmailAddress

1 Answers1