Set sending address - Excel VBA

[rowbro]

Good day, we have some code that sends a bulk email from a second email account on a PC, and for some reason we are not able to get this code to use the desired email address. Please see code below. can you see the issue as to why this is sending from the default, not second, email address?

Sub Send_Email()
Dim edress As String
Dim subj As String
Dim message As String
Dim filename As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim path1 As String
Dim path2 As String
Dim lastrow As Integer
Dim attachment1 As String
Dim attachment2 As String
Dim FirstName As String
Dim LastName As String
Dim Numshares As Integer
Dim Amountreceived As String

Dim rng As Range
Dim cell As Range


Set outlookapp = CreateObject("Outlook.Application")


Set rng = Sheet1.Range("A2:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)

For Each cell In rng
    Set outlookmailitem = outlookapp.createitem(0)
    Set myAttachments = outlookmailitem.Attachments
    path1 = Sheet1.Range("K2").Value
    path2 = Sheet1.Range("K1").Value

    edress = cell.Value
    subj = cell.Offset(0, 1).Value
    filename = cell.Offset(0, 2).Value
    FirstName = cell.Offset(0, 3).Value
    LastName = cell.Offset(0, 4).Value

attachment1 = path1
attachment2 = path2 & "Application Form.docx"

    outlookmailitem.To = edress
    outlookmailitem.cc = ""
    outlookmailitem.bcc = ""

    outlookmailitem.Subject = "Test 13July"
    outlookmailitem.display
    Signature = outlookmailitem.HTMLBody
    

    outlookmailitem.SendUsingAccount = outlookapp.Session.Accounts.Item("account2@email.com")
        
    
    On Error Resume Next
    myAttachments.Add (attachment1)
    myAttachments.Add (attachment2)
    outlookmailitem.HTMLBody = "Good Afternoon " & FirstName & LastName & "," & "<br>" & "<br>" & " Please find attached for your kind attention. " & "<br>" & "<br>" & _
    "" & vbCrLf & "<br>" & outlookmailitem.HTMLBody
    'End
    'On Error GoTo 0

    outlookmailitem.display
    'outlookmailitem.Send

    lastrow = lastrow + 1
    edress = ""
    x = x + 1
  Next cell
  
    Set outlookapp = Nothing
    Set outlookmailitem = Nothing
    Set myAttachments = Nothing
  
End Sub

 

[DanteAmor]

Try the following:

Change this:

outlookmailitem.SendUsingAccount = outlookapp.Session.Accounts.Item("account2@email.com")

For this:

outlookmailitem.SendUsingAccount = outlookapp.Session.Accounts.Item(2)

----------------
Or this option:

outlookmailitem.SentOnBehalfOfName = "account2@email.com"

 

[rowbro]

Thanks Dante. Tried both of these, but not joy on either.

I am out of ideas - can only think its something to do with the main account being an MSFT Exchange account and the other being old school POP3 + SMTP setup.

Any other ideas?

 

[DanteAmor]

Check if you can somehow check the ID number of the accounts.

That number is the one you should put in this line:

outlookmailitem.SendUsingAccount = outlookapp.Session.Accounts.Item(2)