Hello folks:
I have written the code below, which works great. However, my Outlook has multiple email addresses and the code below keeps selecting my default address as a sender. I tried setting my other account as the new default, but my code kept sending from the original address. My question is, how can the code below be changed to email from a specific email address?
I have written the code below, which works great. However, my Outlook has multiple email addresses and the code below keeps selecting my default address as a sender. I tried setting my other account as the new default, but my code kept sending from the original address. My question is, how can the code below be changed to email from a specific email address?
VBA Code:
Sub SendEmailAttachment()
Dim outlookApp As Object
Dim outMail As Object
Dim myAttachments As Object
Dim emailAddress As String
Dim emailAddressCC As String
Dim emailSubject As String
Dim fileName As String
Dim filePath As String
Dim attachment As String
Dim attachment2 As String
Dim signature As String
Dim lastrow As Integer
Dim x As Integer
x = 2
Do While Sheet1.Cells(x, 1) <> ""
Set outlookApp = CreateObject("Outlook.Application")
Set outMail = outlookApp.CreateItem(0)
Set myAttachments = outMail.Attachments
filePath = ThisWorkbook.Path & "\"
emailAddress = Sheet1.Cells(x, 3)
emailAddressCC = Sheet1.Cells(x, 13)
emailSubject = Sheet1.Cells(x, 17)
fileName = Sheet1.Cells(x, 16)
attachment = filePath + fileName
attachment2 = filePath + "CEO Letter to Employees.Pdf"
With outMail
.Display
End With
signature = outMail.HTMLbody
With outMail
.To = emailAddress
.cc = emailAddressCC
.bcc = ""
.Subject = emailSubject
.HTMLbody = "Please find your statement attached" & vbCrLf & "Best Regards" & signature
myAttachments.Add (attachment2)
myAttachments.Add (attachment)
.Display
lastrow = lastrow + 1
emailAddress = ""
x = x + 1
Set outlookApp = Nothing
Set outMail = Nothing
End With
Loop
End Sub