Nested IFs to send emails vis VBA - excel

I am trying to complete some VBA to send an email to different people based on set criteria(1, 2 or 3).
I can get the email to send on an IF with the first part but cannot get it to include the different criteria.
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
If Sheets("Master").Range("D18") = 1 Then
ActiveWorkbook.Save
On Error Resume Next
With OutlookMail
.To = "x1#1.co.uk"
.CC = "x1#1.co.uk"
.BCC = ""
.Subject = "Holiday Response"
.Body = "Hi, please find attached the requested Holiday thank you." & vbNewLine & Signature
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
ElseIf Sheets("Master").Range("D18") = 2 Then
ActiveWorkbook.Save
On Error Resume Next
With OutlookMail
.To = "x2#2.co.uk"
.CC = "x2#2.co.uk"
.BCC = ""
.Subject = "Holiday Response"
.Body = "Hi, please find attached the requested Holiday thank you." & vbNewLine & Signature
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
Else
ActiveWorkbook.Save
On Error Resume Next
With OutlookMail
.To = "x3#3.co.uk"
.CC = "x3#3.co.uk"
.BCC = ""
.Subject = "Holiday Response"
.Body = "Hi, please find attached the requested Holiday thank you." & vbNewLine & Signature
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End If
End Sub
Email will send to different people based on the different criteria being met.
Error message currently shows Compile Error: Else without If

You were missing some End With in your code. You can also avoid repeating all these unnecessary lines of code and simplify a little bit. This will work:
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
ActiveWorkbook.Save
With OutlookMail
.BCC = ""
.Subject = "Holiday Response"
.Body = "Hi, please find attached the requested Holiday thank you." & vbNewLine & Signature
.Attachments.Add Application.ActiveWorkbook.FullName
If Sheets("Master").Range("D18") = 1 Then
.To = "x1#1.co.uk"
.CC = "x1#1.co.uk"
ElseIf Sheets("Master").Range("D18") = 2 Then
.To = "x2#2.co.uk"
.CC = "x2#2.co.uk"
Else
.To = "x3#3.co.uk"
.CC = "x3#3.co.uk"
End If
'Here use a proper error handling
'On Error Resume Next
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Note: As already stated, you need to implement a proper error handling in case of failure sending your mail.
Hope this helps.

Related

How to embed an image into an Outlook email using VBA

Very closely related to Embed picture in outlook mail body excel vba
I'm trying to embed an image into an Outlook email.
I'm using the following code snippet, half of which has been stolen from the post above:
Sub PictureEmail()
Dim outApp As New Outlook.Application
Dim OutMail As Object
Dim Attchmnt As String
Dim Signature As String
Dim WB As Workbook
Set WB = ThisWorkbook
Attchmnt = "C:\Users\Blah\Painted_Lady_Migration.jpg"
Set OutMail = outApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg""height=520 width=750>"
.display
End With
If Attchmnt = "" Then
Else
OutMail.Attachments.Add Attchmnt
End If
On Error GoTo 0
End Sub
However, when looking at the generated email, I have the error "The linked image cannot be displayed. The file may have been moved, renamed, or deleted".
I've tried a few different ways to attach the file, including:
.HTMLBody = "<img src=" & Chr(34) & "cid:Painted_Lady_Migration.jpg" & Chr(34) & "height=520 width=750>"
I just can't get it to work >_<
I saw somewhere that spaces in the name/filepath can throw it, so I replaced the spaces in the name with underscores
What dumb thing am I forgetting/missing?
The cid is created when you attach it, so you need to do that before you display/send it.
Try it like this
Set OutMail = outApp.CreateItem(0)
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
If Attchmnt <> "" Then
.Attachments.Add Attchmnt ' (additional arguments are optional)
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg"" height=520 width=750>"
Else
.HTMLBody = "[no attachment included]"
End If
.Display
End With

Send Outlook Email with some Bold Text

I have code that opens up an Outlook email with the content of the mail body, but none of the format is working.
In the email, it just shows up as a string Like:
<strong>Bold this part</strong>Unbold this text
<b>This text bold</b>Test
I have been searching answers here, but none of them work.
Here is my code so far:
Sub Send_email()
Dim OutApp As Object
Dim OutMail As Object
Dim MailBody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
MailBody = "First line of email" & vbNewLine & vbNewLine & _
"<strong>Bold this part</strong>" & "Unbold this text" & vbNewLine & _
"<b>This text bold</b>" & "Test"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.Body = MailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Use MailItem.HTMLBody instead of MailItem.Body.
Returns or sets a String representing the HTML body of the specified item. Read/write.
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.HTMLBody = MailBody
.Display 'or use .Send
End With

Use a named range as an email list in excel

I'm new here and just learning to code. I'm working on an Excel form and I need to use a named a range on a separate work sheet as an email list. Is there a way to add this to the .To= field?
Private Sub Email_Click()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = Range("G2") & " Shift Turnover Report is attached"
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Range("G2") & " Shift Turnover Report"
.Body = xMailBody
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With
If Err Then
MsgBox "Hmmm. Something went wrong." & vbLf & "Please try again.", vbExclamation
Else
MsgBox "Your message has been sent.", vbInformation
End If
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
You may try something like this...
Dim x, Emails()
Dim strEmails As String
x = Range("EmailNamedRange").Value
Emails() = Application.Index(x, 0, 1)
strEmails = Join(Application.Transpose(Emails), ";")
With xOutMail
.To = strEmails
.CC = ""
.BCC = ""
.Subject = Range("G2") & " Shift Turnover Report"
.Body = xMailBody
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With

Sending outlook emails from Excel

I have the below VBA that sends an email fine:
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = ""
With .Item
.To = "123#321.com"
.CC = ""
.BCC = ""
.Subject = "A new deli pre-order has been received."
.Send
End With
The part where I am now struggling is to set who the email has come from
I thought adding the below would work:
.From = "111#222.com"
What happens when adding the above:
No email is received at all
What am I missing?
You can try .SendUsingAccount to select the account which you are going to send the e-mail.
With .Item
.SendUsingAccount = olAccount 'or some other account.
.To = "123#321.com"
.CC = ""
.BCC = ""
.Subject = "A new deli pre-order has been received."
.Send
End With
You're probably looking for .SenderEmailAddress or .SentOnBehalfOfName.
Try it this way.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
https://www.rondebruin.nl/win/s1/outlook/amail1.htm

VBA, Insert outlook signature in vba code

I have a vba code which sends automatically emails when a due date is approaching at least 7 seven days from the current date.
The problem is they when the email is sent without my outlook signature.
The code is:
Sub email()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Cells(i, 3)
If toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "Doukementacion per " & Cells(i, 2) & " Targa " & Cells(i, 5)
eBody = "Pershendetje Adjona" & vbCrLf & vbCrLf & "Perfundo dokumentacionin e nevojshem per " & Cells(i, 2) & " me targa " & Cells(i, 5)
On Error Resume Next
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 11) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
What I found helpful was to make it a HTMLBody. so this part:
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
would look like
With OutMail
.Display 'ads the signature
.To = toList
.Subject = eSubject
.HTMLBody = eBody & .HTMLBody
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
You might need to toggle events, not sure since I haven't tested with events disabled
If you don't have picture in your signature and can use .body , then you can just use this simplest tool in my opinion.
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
End With
Signature = OutMail.body
With OutMail
.Subject = "This is the Subject line"
.Body = strbody & Signature
.Send 'or use .Display
End with
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
Have a great day

Resources