I have a code to send email from excel. All the info is taken from cells. I am trying to make "J4" bold but it says symtex error when I use . Sorry i'm pretty new to VBA so please explain as if i'm a complete noob.
Code is:
Sub SendMassEmail()
Row_Number = 1
Do
DoEvents
Row_Number = Row_Number + 1
Dim Mail_Body_Message As String
Dim Full_Name As String
Dim Twitter_Code As String
Mail_Body_Message = Sheet1.Range("J2") & vbNewLine & Sheet1.Range("J3") & vbNewLine & Sheet1.Range("J4") & vbNewLine & Sheet1.Range("J5") & vbNewLine & Sheet1.Range("J6")
Full_Name = Sheet1.Range("B" & Row_Number)
Twitter_Code = Sheet1.Range("D" & Row_Number)
Mail_Body_Message = Replace(Mail_Body_Message, "replace_name_here", Full_Name)
Mail_Body_Message = Replace(Mail_Body_Message, "promo_code_replace", Twitter_Code)
MsgBox Mail_Body_Message
Call SendTheEmail(Sheet1.Range("A" & Row_Number), "This is the Subject", Mail_Body_Message)
Loop Until Row_Number = 5
MsgBox "**Emails Sent**"
End Sub
The problem here is that the variable Mail_Body_Message is just text. There is no way to indicate when something is bold or a color. You must use HTML in your email to achieve what you want. For example:
Replace
Mail_Body_Message = Sheet1.Range("J2") & vbNewLine & Sheet1.Range("J3") & vbNewLine & Sheet1.Range("J4") & vbNewLine & Sheet1.Range("J5") & vbNewLine & Sheet1.Range("J6")
With
Mail_Body_Message = "<HTML><BODY><font size=3>" & Sheet1.Range("J2") & vbNewLine & Sheet1.Range("J3") & vbNewLine & "<b>" & Sheet1.Range("J4") & "</b>" & vbNewLine & Sheet1.Range("J5") & vbNewLine & Sheet1.Range("J6") & "</font></BODY></HTML>"
There is some more work you need to do. You must set your mail item's body format to olFormatHTML. You must also set the HTMLBody of the message to your variable. Basically, you'll need something like this:
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.BodyFormat = olFormatHTML
.HTMLBody = Mail_Body_Message
.Send
End With
You can also change the color of text with HTML font tags. For example:
Mail_Body_Message = "<font color='red'>" & VBAVariable & "</font>"
Related
Im using below vba query to generate emails with attachment. However, i do not want the query to generate the details in attachments. Instead, i want the data to be paste in body of the email. Im not sure how to amend it. Please help
Sub Buyer_HU()
Dim c As Range, sh As Worksheet, Ky As Variant, dam As Variant, dict As Object
Dim correo As String, lr As Long, wFile As String
Dim tempData As String '<== Changes here
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh = Sheets("Template")
If sh.AutoFilterMode Then sh.AutoFilterMode = False
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("BA:BA").ClearContents
For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))
sh.Range("BA" & c.Row) = c & sh.Range("M" & c.Row) & sh.Range("M" & c.Row)
Next
Set dict = CreateObject("scripting.dictionary")
For Each c In sh.Range("BA2", sh.Range("BA" & Rows.Count).End(xlUp))
dict.Item(c.Value) = sh.Range("M" & c.Row)
Next
For Each Ky In dict.Keys
correo = dict(Ky)
sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky
sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky, xlOr, " ", True
'ActiveSheet.Range("$A$1:$BA$2000").AutoFilter 53
Workbooks.Add
sh.AutoFilter.Range.EntireRow.Copy Range("A1")
Dim wcc
wcc = Range("AY1")
Range("BA:BA").ClearContents
Range("BA:BA").ClearContents
Range("AY:AY").ClearContents
Range("M:M").ClearContents
Cells.Select
Selection.Columns.AutoFit
Range("A2").Select
tempData = ActiveSheet.Range("A2").Value '<== Changes here
wFile = ThisWorkbook.Path & "\Back orders report " & Format(Now(), "dd.mm.yyyy") & "_" & tempData & ".xlsx" '<== Changes here
ActiveWorkbook.SaveAs wFile
ActiveWorkbook.Close False
Set dam = CreateObject("Outlook.Application").CreateItem(0)
With dam
.SentOnBehalfOfName = wcc
'.Bodyformat = olFormatHTML
.To = correo
.cc = ""
.Subject = "Back orders report " & Format(Now(), "dd.mm.yyyy") & "_" & tempData '<== Changes here
.HTMLBody = "Good Morning," & "<br>" & "<br>" & "Please see attached for today's reports." & "<br>" & "<br>" & "Please use the below coding:" & "<br>" & "<br>" & "07/12/2030 - means call off order" & "<br>" & "06/12/2030 - means shipped and orders can be invoiced off" & "<br>" & "05/12/2030 - means order not received - please resend" & "<br>" & "04/12/2030 - means order cancelled - please cancel off at your end if not already done" & "<br>" & "03/12/2030 - means delivery date not known" & "<br>" & "02/12/2030 - means held, more info required" & "<br>" & "01/12/2030 - means held, price problem" & "<br>" & "<br>" & "All other dates should be ETA?dates (If promise date is unchanged please leave blank)" & "<br>" & "<br>" & "PLEASE REPLY IN FORMAT SENT" & "<br>" & "<br>" & "Backorder Report - Please Return by 12pm." & "<br>" & "<br>" & "Thanks and Regards," & "<br>" & "Currys B2B Planning Team"
.Attachments.Add wFile
.Display 'use .Send to send
End With
Next Ky
'sh.ShowAllData
'Selection.AutoFilter
Columns("BA:BA").Select
Selection.Delete Shift:=xlToLeft
MsgBox "Emails generated"
Range("A2").Select
End Sub
I am using the code below which is basically taken a screenshot of an userform and paste it in an outlook application. The macro is working fine.
What I am trying to achieve is to put an email introduction and then after paste the screenshot, but I am not able to do it properly because the screenshot is not being put after the text.
This is my code
Sub Screenshotemail()
Dim doc As Object, rng As Range
Application.SendKeys "(%{1068})"
DoEvents
'ActiveSheet.Paste
With CreateObject("Outlook.Application").CreateItem(0)
Set doc = .GetInspector.WordEditor
doc.Range(0, 0).Paste
.display
.To = ""
.CC = ""
.Body = "Dear All, " & Chr(10) & Chr(10) & "I kindly remind you that forecasts for program " & Chr(10) & Chr(10) _
& "Please enter your forecast at the link below." _
& Chr(10) & Chr(10) & lien & Chr(10) & Chr(10) & "Best Regards,"
.Subject = "Test:"
.Importance = olImportanceHigh
End With
End Sub
Is there a way to make it work?
My friend, It take me a few hours but i guess it works
just use, htmlbody instead body, and concat the htmlbody after your messagge
reference
Write before paste table in Outlook - Excel VBA
Sub Screenshotemail()
Dim doc As Object, rng As Range
Dim wdDoc As Object
Dim wdRange As Range
Application.SendKeys "(%{1068})"
DoEvents
Set wdDoc = CreateObject("Word.Application")
'ActiveSheet.Paste
With CreateObject("Outlook.Application").CreateItem(0)
Set doc = .GetInspector.WordEditor
doc.Range(0, 0).Paste
.display
.To = ""
.CC = ""
.htmlbody = "Dear All, " & Chr(10) & Chr(10) & "I kindly remind you that forecasts for program " & Chr(10) & Chr(10) _
& "Please enter your forecast at the link below." _
& Chr(10) & Chr(10) & lien & Chr(10) & Chr(10) & "Best Regards," & .htmlbody
.Subject = "Test:"
.Importance = olImportanceHigh
End With
End Sub
I'm using this code to create an e-mail
however, I would like to send the content that is in the range A5 to B100, like this:
A5 B5
A6 B6
...
A100 B100
what do you suggest?
current code, looks like this:
Public Function Sendemail()
On Error GoTo Ende
esubject = "CBP Review for Approval"
sendto = Range("G1") & Range("H1")
ccto = Range("G1")
ebody = "Please see below a" & vbNewLine & Range("A5") & " " & Range("B5") & vbCrLf & "Best regards" & vbCrLf & "Your Partner"
Set app = CreateObject("Outlook.Application")
Set itm = app.CreateItem(0)
With itm
.Subject = esubject
.To = sendto
.CC = ccto
.Body = ebody
.Display
End With
Set app = Nothing
Set itm = Nothing
the way it is now, just writes A5 and B5 but need a loop to write the other ones
many thanks
I wrote out the answer, but your questions states you already know what you have to do. Why not just look it up? First result from google search "vba loop"
Can use UsedRange.Rows.Count to get last row. If your loop is beyond your range of data, or has blanks, you'll want to uncomment the if statement. So you don't end up with a bunch of newlines.
Dim sData as string
For iRowCounter = 5 to ??
'if Range("A" & iRowCounter) <> "" or Range("B" & iRowCounter) <> "" then
sData = sData & Range("A" & iRowCounter) & " " & Range("B" & iRowCounter) & vbNewline
'end if
Next
eBody = "Please see..." & vbnewline & sData & "Best Regards..."
You can use a For loop to build up the body of your message one row at a time. Replace the following line:
ebody = "Please see below a" & vbNewLine & Range("A5") & " " & Range("B5") & vbCrLf & "Best regards" & vbCrLf & "Your Partner"
with the following code:
ebody = "Please see below a" & vbNewLine
For i = 5 To 100
If Range("A" & i) <> "" or Range("B" & i) <> "" Then
ebody = ebody & Range("A" & i) & " " & Range("B" & i) & vbCrLf
End If
Next i
ebody = ebody & "Best regards" & vbCrLf & "Your Partner"
Note the two different uses of concatenation (& operator), one to add new lines to the existing body:
ebody = ebody & "more text to add..."
and another to create the cell reference on each line. Range("A" & i) inside the loop will result in cells A5 to A100 (and similarly B5 to B100) to be added to the message.
Finally, the If statement will make sure that only rows that have data in either cell A or B will be added to your email.
I have code in Excel which sends email to a list of recipients:
Sub SendEMail()
Dim xEmail As String
Dim xSubj As String
Dim xMsg As String
Dim xURL As String
Dim i As Integer
Dim k As Double
Dim xCell As Range
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the data range:", "Send emails to:", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count <> 3 Then
MsgBox "Incorrect number of columns: You have to choose Name, Email address, Account no.!"
Exit Sub
End If
For i = 1 To xRg.Rows.Count
' Get the email address
xEmail = xRg.Cells(i, 2)
' Message subject
xSubj = "Your customer's account is on hold"
' Compose the message
xMsg = ""
xMsg = xMsg & "Dear client" & "," & vbCrLf & vbCrLf
xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - "
xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
xMsg = xMsg & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf
xMsg = xMsg & "Kind regards," & vbCrLf
xMsg = xMsg & "Jon and Martina"
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
I would like to add variable attachments. It will be a pdf file and its name will be the same as the name of customer (which is placed in column A). Basically it should look for "Name.pdf" in "S:\All Team\AX OTI\test\"
The source table looks like:
Please try to use the below code.
xMsg = xMsg & "Dear client" & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf 'Added the client Name (optional) you can remove it
xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - "
xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
xMsg = xMsg & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf
xMsg = xMsg & "Kind regards," & vbCrLf
xMsg = xMsg & "Jon and Martina" & vbCrLf & vbCrLf 'Added two break point
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg &"&attachment=S:\All Team\AX OTI\test\" & Cells(i,1) & ".pdf" 'Changed to this
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Based on #Vityata advice, I've checked the question and based on that, I' ve changed the code. It is tested and works smoothly. The code is much easier, but the job is done.
Sub SendEmail()
Dim Mail_Object, OutApp As Variant
With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row 'list of recipients (email address) - it takes as many addresses as B column contains
End With
For i = 2 To lastrow
Set Mail_Object = CreateObject("Outlook.Application")
Set OutApp = Mail_Object.CreateItem(0)
With OutApp
.Subject = "Your customer's account is on hold"
.Body = "Dear client" & "," & vbCrLf & vbCrLf & "We would like to inform you, that Your account has been put on hold." & vbCrLf & vbCrLf & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf & "Kind regards," & vbCrLf & "Jon and Martina"
.To = Cells(i, 2).Value
strLocation = "S:\All team\AX OTI\test\" & Cells(i, 1) & ".pdf"
.Attachments.Add (strLocation)
.display
'.send
End With
Next i
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
Here you have something that works really nicely - Add attachement to outlook with varying file names
In your case, simply copy the code and make sure that in the part strLocation you write something like:
strLocation = "C:\Users\user\Desktop\" & Cells(i,2) & ".pdf"
thus, you will be able to loop around it. In general, take a good look at the mentioned answer, it is really a good approach (IMHO quite better than sending keys).
I would like to insert a link inside the body of the e-mail I am creating through excel VBA. The link changes every day so I have put its value in cells B4. However, I do not find a proper way to send the e-mail with that link.
This is the code I am using :
Public Sub email_missing_forecast()
Application.ScreenUpdating = False
'Déclaration des variables
derniereligne = Range("B5000").End(xlUp).Row
Project_number = Cells(1, 2).Value
Project_name = Cells(2, 2).Value
Project_due = Cells(3, 2).Value
Link = Cells(4, 2).Value
Dim Objoutlook As New Outlook.Application
Dim Objectmail
'Condition
For i = 6 To derniereligne
Adresse = Cells(i, "D").Value
Adresse2 = Cells(i, "E").Value
Adresse3 = Cells(i, "F").Value
If Cells(i, "B").Value = "No" Then
Set Objoutlook = New Outlook.Application
Set Objectmail = Outlook.createitem(olmailitem)
With Objectmail
.To = Adresse & ";" & Adresse2 & ";" & Adresse3
.Subject = "Bobbi Brown | " & Project_number & " " & Project_name & " | Forecast due " & Project_due
.Body = "Dear All, " & Chr(10) & Chr(10) & "I kindly remind you that forecasts for program " & Project_number & " " & Project_name & " are due " & Project_due & "." & Chr(10) & Chr(10) & "Please enter your forecast at this link below." & Chr(10) & Chr(10) & Link & Chr(10) & Chr(10) & "Best Regards," & Chr(10) & "Christian Chen"
.Send
End With
End If
Next i
Application.ScreenUpdating = True
MsgBox "Your e-mails have been sent successfully", , "FIY"
End Sub
There are only two possibilities IMHO:
the plain text Email: NO clickable link is possible
the HTML Email: clickable link is possible, well-formed HTML WITH <body> Tag is necessary!