Sub ColdEmail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastrow As Long
Dim iCounter As Long
Dim MailDest As String
Dim subj As String
Dim bod As String
Dim ws As Worksheet
Dim signature As String
lastrow = ThisWorkbook.Worksheets("Prospects").Cells(Rows.Count, "D").End(xlUp).Row 'change worksheet
For iCounter = 2 To lastrow
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then
signature = signature & Dir$(signature & "*.htm")
Else:
signature = ""
End If
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
With OutLookMailItem
subj = ""
MailDest = ""
bod = ""
If Cells(iCounter, 13) = "*" Then
subj = Cells(iCounter, 14).Value
MailDest = Cells(iCounter, 7).Value
bod = Cells(iCounter, 16).Value
.BCC = MailDest
.Subject = subj
.HTMLBody = bod & signature
.Send
End If
End With
Next iCounter
End Sub
The code above sends emails automatically to a column of e-mail addresses and it gets the body paragraph from a column in Excel as well.
I wanted my messages to include my default signature in Outlook, so I changed my code to HTMLbody.
The e-mails sent out don't retain the original paragraph spacing:
line 1
line 2
line 3
It looks like this now: line1 line2 line3.
I would echo Scott Holtzman's advice to read up on HTML. Whenever I've needed to do HTML formatting in an email, I've found that <br> is the most straightforward option. Using one <br> will move text to the next line. To create white space, (like, a blank line between paragraphs) use <br><br>.
You can put this right into the cell where your text is located. The brackets will mark this as HTML and it will be rendered in the email as a break rather than as readable text.
In other words: Thanks,<br>Cthulhu in your excel cell, will render as
"Thanks,Cthulhu" in your email.
It would serve you well to read up on coding HTML.
For now, you can do this:
To load the default signature (already set in outlook), you can do the below (and eliminate your code to get the signature):
With OutLookMailItem
.Display
signature = .HTMLBody
....
To format the HTML for the body you can do something like this:
'change font info as needed
bod = "<BODY style=font-size:12pt font-family:Times New Roman font-color:blue>" _
& "<p>" & Cells(iCounter, 16).Value & "</p>" _
& "</BODY>" _
& signature
Related
I send an email through Outlook. I am trying to put an email address link within the body of the email, so that one can click on it and an email opens.
E.g. "If you have any questions, please contact us at ABC", where the "ABC" is the link that represents email address, ABC#gmail.com (not the real address).
I understand, from scouring the web, this is the syntax:
<a href="mailto:ABC#gmail.com\>ABC\</a>
I borrowed code that uses HTML to format a message in the body of an email, and replaced a line with what I wanted.
I received a Compile Error (which I think is actually a syntax error in this case?).
When debugging, the "mailto" text was highlighted.
My insertion:
ABC mailbox
.HTMLBody = "\<HTML\>\<BODY\>\<a href="mailto:ABC#gmail.com"\>ABC mailbox\</a>\</BODY\>\</HTML\>"
Sub SendEmailformattext()
'Update by Extendoffice.com
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim OutlookApp As Object
Dim MItem As Object
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(olMailItem)
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each xRgEach In xRg
xRgVal = xRgEach.Value
If xRgVal Like "?*#?*.?\*" Then
Set MItem = xOutApp.CreateItem(olMailItem)
With MItem
.Display
.To = xRgVal
.Subject = "Test"
.HTMLBody = "\<HTML\>\<BODY\>\<a href="mailto:ABC#gmail.com"\>ABC mailbox\</a>\</BODY\>\</HTML\>"
'.Send
End With
End If
Next
Set xMailOut = Nothing
UNCLASSIFIED
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub
The original code worked so I know the mailto text is the problem.
Use the Chr(34) function if you need to use double quotes in the string:
.HTMLBody = "\<HTML\>\<BODY\>\**<a href="& Chr(34) & "mailto:ABC#gmail.com" & Chr(34) & "\>ABC mailbox\</a>**\</BODY\>\</HTML\>"
I am trying to sent an email from outlook using Excel Macro and I need a solution on how I can move the tables I copy paste from the Excel to Outlook body, which will always get aligned to left side, and I want it to be moved to little right so that I will get a perfectly fit/alignment with the other contents I have on the top.
My Code
Sub Table_CopyPaste()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application") Set newEmail = outlook.CreateItem(0)
StrBody1 = "<o:p> </o:p><p class=MsoNormal><span lang=EN-US style='color:#1F497D'><span style='font:11.0pt 'Calibri'>Hello,</Span></p><p class=MsoNormal><span style='font:11.0pt 'Calibri(Body)'>Attached you can find a file with all your Status for month 10_2019. </p></span><p class=MsoNormal><span style='font:11.0pt 'Calibri(Body)'>Below you can find an overview of your current status and your unit status.</span></span></p>" _
& "<p class=MsoListParagraph style='margin-left:53.4pt;text-indent:-18.0pt;mso-list:l0 level1 lfo2'><span style='font:11.0pt 'Calibri'><span lang=EN-US style='color:#1F497D'>1) We have extended the report with additional information, so you can develop a more complete view on your status:" _
& "<br>" _
& "<br> -   HR" _
& "<br> -   Accounts" _
& "<br> -   Finance" _
With newEmail
.To = "Test#mail.com"
.CC = ""
.BCC = ""
.Subject = "Data"
.HTMLBody = StrBody1
.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Sheets("Statistics_Sheet").Range("A3:D6").Copy
pageEditor.Application.Selection.Start = Len(.HTMLBody)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.Display
'.Send
Set pageEditor = Nothing
Set xInspect = Nothing End With
Set newEmail = Nothing Set outlook = Nothing
End Sub
This is the first time I am working on integrating outlook with macro, so no much idea how to solve this. The code is working fine once we run this code I need the table to be placed aligned with the bullet point 'Finance'
After too many search here and there, I find that its not possible to move it but a workaround here is to add some extra blank cells in that range so that when it copy pasted to outlook you will get it aligned to the text (Adjust the width of the cells to change the alignment)
But I find a code which work like a charm,
Sub PublishTable()
Dim WB As ThisWorkbook, P As String, WS As Worksheet, Rng As Range, New_WB As Workbook, RNG2 As Range, FolderPath As String
Set WB = ThisWorkbook
Set WS = WB.Sheets("Statistics_Sheet")
FolderPath = Application.ActiveWorkbook.Path
Set Rng = Sheets("Statistics_Sheet").Range("C3:F6")
P = FolderPath & "\Calculation_of_exception_status.html"
Workbooks.Add
Set New_WB = ActiveWorkbook
ThisWorkbook.Activate
Rng.Copy
New_WB.Activate
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
ActiveCell.PasteSpecial xlPasteColumnWidths
ActiveCell.PasteSpecial xlPasteFormats
New_WB.PublishObjects.Add(xlSourceRange, P, New_WB.Sheets(1).Name, New_WB.Sheets(1).UsedRange.Address, xlHtmlStatic).Publish (True)
ActiveWorkbook.Close SaveChanges:=False
Dim fso As New FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim Final_File As Scripting.TextStream
Set Final_File = fso.OpenTextFile(P, ForReading)
StrTable2 = Final_File.ReadAll
End Sub
And when you use Strtable2 in your outlook body use below code, adjust '20.3pt' according to your requirement.
olMailItm.HTMLBody = "<table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 style='margin-left:20.3pt;border-collapse:collapse'>" & StrTable2 & "</Table>"
If it's an actual HTML <table> element that it inserts, you can add a stylesheet to the .HTMLBody
At the top, Dim a variable:
Dim sStyles As String
sStyles = "<style> table {margin-left:150px;} table table {margin-left:0px;} </style><br>"
And then where you set the .HTMLBody, add it in like this:
.HTMLBody = sStyles & StrBody1
Then adjust the 150 number in the code to whatever you want to get it to align where you want it.
I'm setting up a Excel file with any amount of email addresses and for each a column with the subject.
I want to send personalized emails to the addresses based on the subject.
So if email address x has subject y, I want to get the html script for this email out of a html file which I have created for all emails with this subject.
I thought I could realize it by getting the mailitem.htmlbody directly out of the different html files which I will create for each subject. https://learn.microsoft.com/de-de/office/vba/api/outlook.mailitem.htmlbody
I tried to get the body text out of a html file.
Sub Send_email_fromexcel()
Dim edress As String
Dim subj As String
Dim message As String
Dim filename, fname2 As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim path As String
Dim lastrow As Integer
Dim attachment As String
Dim x As Integer
x = 2
Do While Sheet1.Cells(x, 1) does not equal ""
Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.createitem(0)
Set myAttachments = outlookmailitem.Attachments
path = "C:\Users\Barb\Documents\statements\"
edress = Sheet1.Cells(x, 1)
subj = Sheet1.Cells(x, 2)
filename = Sheet1.Cells(x, 3)
fname2 = "excellogo.jpg"
attachment = path + filename
outlookmailitem.To = edress
outlookmailitem.cc = ""
outlookmailitem.bcc = ""
outlookmailitem.Subject = subj
outlookmailitem.Attachments.Add path & fname2, 0
outlookmailitem.HTMLBody = "Thank you for your contract br" _
& " br We will work to acheive the results you require.br" _
& "br For any further questions please feel free to contact us any time br " _
& "br or visit our website at www.easyexcelanswers.com br" _
& "p:(780) 499-6658 br" _
& "Canada br" _
& " br img src='excellogo.jpg'" & "width='146' height='138'"
//->> here I want to get the html out of a seperate file instead of writing the text into the code
'outlookmailitem.body = "Please find your statement attached" & vbCrLf & "Best Regards"
myAttachments.Add (attachment)
outlookmailitem.display
'outlookmailitem.send
lastrow = lastrow + 1
edress = ""
x = x + 1
Loop
Set outlookapp = Nothing
Set outlookmailitem = Nothing
End Sub
I expect to have a personalized email for each contact, based on his gender/name and the mail subject.
Read the html file and include that in the code.
I assume it's filename you want.
Dim html As String
Dim iFile As Integer: iFile = FreeFile
Open filenameFor Input As #iFile
html = Input(LOF(iFile), iFile)
Close #iFile
Then append the html to your body.
outlookmailitem.HTMLBody = "Thank you for your contract br" _
& " br We will work to acheive the results you require.br" _
& "br For any further questions please feel free to contact us any time br " _
& "br or visit our website at www.easyexcelanswers.com br" _
& "p:(780) 499-6658 br" _
& "Canada br" _
& " br img src='excellogo.jpg'" & "width='146' height='138'"
& html
When I .Display mail, to add the signature, two empty lines are added above the signature. Is there a way to remove them, to make the mail look better, without losing the signature formatting?
With objOutlookMsg
.SentOnBehalfOfName = "test#stackoverflow.com"
.To = "test#stackoverflow.com"
.CC = "test#stackoverflow.com"
.Subject = "Stackoverflow"
' Tekst
.Display
.HTMLBody = "<p style='font-family:arial;font-size:13'>" & _
"Hej" & "</p>" & _
vbNewLine & vbNewLine & _
"<p style='font-family:arial;font-size:13'>" & _
"Test Test Test Test Test Test" & "</p>" & _
.HTMLBody
.Display
End With
Picture of mail and signature to show, that there are no empty lines at the beginning.
It's been a few years since you asked this, I just struggled with the same issue, where I wanted the signature to work regardless of who is sending. I figured I would still share here in case anyone else is having similar issues.
I'm not a great coder, but I was able to piece things together through a bunch of different articles/posts to get something working, so there is likely a more efficient way to execute this.
To get the signature, it effectively displays an empty e-mail with default signature, removes the white space, saves it, and then empties and discards the e-mail before moving to the final e-mail send (on my comp just discarding left the signature at the top of the final email). The signature is attached at the end of that e-mail, .HTMLBody is used for both instances.
Here is the full code with 'default' inputs, for anyone else that may stumble across:
Sub sig_and_email_send()
Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'gets default signature from e-mail
With OutMail
'2 = HTMLBody Format
.BodyFormat = 2
.Display
'deletes blank space present before signature
signature = Replace(OutMail.HTMLBody, "<p class=MsoNormal><o:p> </o:p></p>", "")
'removes entire e-mail contents and then closes with discard
OutMail.HTMLBody = Replace(OutMail.HTMLBody, OutMail.HTMLBody, "")
OutMail.Close 1
End With
On Error Resume Next
With OutMail
.to = "email#email.com"
.CC = "email#email.com"
.BCC = "email#email.com"
.Subject = "Subject"
.Attachments.Add "\\network\folder\documents\file.xlsx"
.HTMLBody = .HTMLBody & "Hi," & "whateveryourtextis" & _
"<br>" & "Thanks," & "<br><br>" & signature
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I am fairly new to VBA and I am trying to understand how it really works.
So currently I have an excel sheet with items that have due dates.I was able to look online and send out emails to certain people with their respective due dates. Each email has a link to the excel file thats on a network drive.
However, now I am required to link to somewhere else where each item has a folder. The trick to this is that there is a directory where each item is placed in this directory. They are all within in 1 folder. The folders have the same name as in the text in the excel sheet.
I was wondering if there is a way to take the text from the cell respective to each item and place it in the hyperlink? So depending on the item and when its due. The hyperlink will change every time so it goes to the specific folder. Here is the example of the structure. Y:\Main Directory\Folder 1 and another one would be Y:\Main Directory\Folder 3. I placed the name of each folder next to each item within the excel sheet. Also the column with the name of each folder is in column "B". How would I go about this? Thank you! Much appreciated!
Here is the code:
Option Explicit
Public Sub CheckAndSendMail()
Dim lRow As Long
Dim lstRow As Long
Dim toDate As Date
Dim toList As String
Dim ccList As String
Dim bccList As String
Dim eSubject As String
Dim EBody As String
Dim vbCrLf As String
Dim ws As Worksheet
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Set ws = Sheets(1)
ws.Select
lstRow = WorksheetFunction.Max(3, ws.Cells(Rows.Count, "R").End(xlUp).Row)
For lRow = 3 To lstRow
toDate = CDate(Cells(lRow, "R").Value)
If Left(Cells(lRow, "R"), 4) <> "Mail" And toDate - Date <= 7 Then
vbCrLf = "<br><br>"
toList = Cells(lRow, "F") 'gets the recipient from col F
eSubject = "Text " & Cells(lRow, "C") & " is due on " & Cells(lRow, "R").Value
EBody = "<HTML><BODY>"
EBody = EBody & "Dear " & Cells(lRow, "F").Value & vbCrLf
EBody = EBody & "Text" & Cells(lRow, "C") & vbCrLf
EBody = EBody & "Text" & vbCrLf
EBody = EBody & "Link to the Document:"
EBody = EBody & "<A href='Hyperlink to Document'>Description of Document </A>" & vbCrLf
'Line below is where the hyperlink to the folder directory and the different folder names
EBody = EBody & "Text" & "<A href= 'Link to folder Directory\Variable based on text'>Description </A>"
EBody = EBody & "</BODY></HTML>"
MailData msgSubject:=eSubject, msgBody:=EBody, Sendto:=toList
'Cells(lRow, "W").Value = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column W"
End If
Next lRow
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Function MailData(msgSubject As String, msgBody As String, Sendto As String, _
Optional CCto As String, Optional BCCto As String, Optional fAttach As String)
Dim app As Object, Itm As Variant
Set app = CreateObject("Outlook.Application")
Set Itm = app.CreateItem(0)
With Itm
.Subject = msgSubject
.To = Sendto
If Not IsMissing(CCto) Then .Cc = CCto
If Len(Trim(BCCto)) > 0 Then
.Bcc = BCCto
End If
.HTMLBody = msgBody
.BodyFormat = 2 '1=Plain text, 2=HTML 3=RichText -- ISSUE: this does not keep HTML formatting -- converts all text
'On Error Resume Next
If Len(Trim(fAttach)) > 0 Then .Attachments.Add (fAttach) ' Must be complete path'and filename if you require an attachment to be included
'Err.Clear
'On Error GoTo 0
.Save ' This property is used when you want to saves mail to the Concept folder
.Display ' This property is used when you want to display before sending
'.Send ' This property is used if you want to send without verification
End With
Set app = Nothing
Set Itm = Nothing
End Function
"Description of Document "