How to get current week number in email body (.HTMLBody) using vba - excel

We are publishing emails in which the body contains current week number. I have the vba code ready for the email (reference rondebruin) but I'm not able to get current week to populate in the email body.
Private Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
On Error GoTo errorhandler
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ""
.CC = "" ''
.BCC = ""
.Subject = "Reports"
.HTMLBody = "Hello All," & "<br>" & "<br>" & "Reports for [week_nm] have been published and saved to the designated locations."
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

To get the current week number of the year, use:
Application.WorksheetFunction.IsoWeekNum (Now())
In your code, alter the body line to something like..
.HTMLBody = "Hello All," & "<br>" & "<br>" & "Reports for week " & Application.WorksheetFunction.IsoWeekNum(Now()) & " have been published and saved to the designated locations."

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

How to send an Excel sheet to Outlook mailbox?

I have an Excel document to log work done during the day to be passed to the nightshift so they are kept up-to-date with the days activites and vice versa.
The plan is to fill out the document and click a 'Send' button that will send the newly created Excel sheet to a shared Outlook folder.
My attempts have been scrapes off the web copied & tried, but to no avail.
Maybe it may help :)
Sub outMail()
Dim outApp As Object
Dim oMail As Object
Dim signature As String
Dim obszar As String
Set outApp = CreateObject("Outlook.Application")
Set oMail = outApp.CreateItem(0)
With oMail
.Display
End With
signature = oMail.Body
With oMail
.To = "email#email.com"
.CC = "email2#email.com"
.BCC = ""
.Subject = "Log work done during the day"
.BodyFormat = 2
.Body = "Hello" & Chr(13) & Chr(10) & "The newly created Excel sheet with log work done during the day " & Chr(13) & Chr(10) & signature
'here You put directory to your file, for now its directory to file where macro is
.Attachments.Add ActiveWorkbook.FullName
'now its set to display only, if You want to send automatically put .send as below
.Display
'.Send
End With
End Sub
If you use HTML for the email body, you will also be able to format the mail body. Just change the file path to attach the mail. If you want to include a new line in the mail body use < br > (without space).
Sub StackOverflow()
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
.To = "Johnston#Stackoverflow.com"
.Subject = "Excel Document"
.Display
.HTMLBody = "<p style='font-family:arial;font-size:13'>" & _
"Hi" & "<br>" & "<br>" & _
"Here is the Excel document." & _
.HTMLBody
.Attachments.Add ("C:\Desktop\" & "ExcelDocument.xlsx")
.Display
End With
End Sub

Add hyperlink to Outlook email which goes to row number when opening Excel spreadsheet

I have an Excel spreadsheet which sends email using VBA:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "This is email text, click the link <a href='C:\test.xlsm & Range("F" & ActiveCell.Row).Address'></a>"
On Error Resume Next
With OutMail
.To = "####"
.CC = ""
.BCC = ""
.Subject = "Sales Tracker: A New Task has been added to the tracker"
.HTMLBody = strbody & strbody2 & strbody3 & strbody4
.Send 'displays outlook email
'Application.SendKeys "%s" 'presses send as a send key
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
The email is sent when a user clicks on a specific cell within the active row.
I include the Excel spreadsheet in the email with a hyperlink.
Now I want to add to the hyperlink to include the cell reference of the row the user clicks on.
The idea is the hyperlink when clicked will open the spreadsheet and will take the user to the row the link refers to and highlight it.
You are missing the reference of the sheet in your link (even though I'm not sure that this will be enough), so try something like this :
href='[C:\test.xlsm]" & ActiveSheet.Name & "!" & Range("F" & ActiveCell.Row).Address & "'></a>"
to match this format :
href='[C:\test.xlsm]SheetName!A1'
And more importantly, you forgot to close the quotation marks properly, so here it goes :
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "This is email text, click the link <a href='[C:\test.xlsm]" & _
ActiveSheet.Name & "!" & Range("F" & ActiveCell.Row).Address & "'></a>"
On Error Resume Next
With OutMail
.To = "####"
.CC = ""
.BCC = ""
.Subject = "Sales Tracker: A New Task has been added to the tracker"
.HTMLBody = strbody & strbody2 & strbody3 & strbody4
.Send 'displays outlook email
'Application.SendKeys "%s" 'presses send as a send key
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
I'm not sure if it's possible to do it with hyperlink, most likely not. Only thing that comes to my mind is to add Worksheet_Activate() event to spreadsheet you are attaching, and there point to range you wish, but not with hyperlink.

excel vba sending email validation list

Currently I have a sheet that sends a email to a specific email address, on this sheet there is a specific validation list with two options. If I select one option it will send an email to the email specified. However if I select the second option nothing happens. And there is no error.
I would like to be able to send the sheet two different email address depending on what has been selected within the list, and press click on the send button.
Code:
Private Sub CommandButton1_Click()
If Sheet1.Range("G31") = "in the cell(see notes below)" Then
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim fName As String
fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"
ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR.ALI# "
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
Else
If Sheet1.Range("G31") = "Multiple applicants registered at the same address" Then
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR.ALI#__________ "
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
End If
End If
End Sub
I just figured out why it was fundamentally not working. You need to declare and set your objects inside both branches of the IF. The way it's setup right now, you declare them in the top block, but not the bottom one.
You need to have those lines in the Else part as well :
dim OutApp as object
Set OutApp = CreateObject("Outlook.Application")
dim OutMail as object
set OutMail = OutApp.CreateItem(0)
Try this code out :
Private Sub CommandButton1_Click()
If Sheet1.Range("G31") = "in the cell(see notes below)" Then
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim fName As String
fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"
ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR.ALI# "
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
ElseIf Sheet1.Range("G31") = "Multiple applicants registered at the same address" Then
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR.ALI#__________ "
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
End If
End Sub
I have initialised the Outlook variables toward outside the If statement and it now seems to work.
Private Sub CommandButton1_Click()
dim OutApp as object
Set OutApp = CreateObject("Outlook.Application")
dim OutMail as object
set OutMail = OutApp.CreateItem(0)
If Sheet1.Range("G31") = "in the cell(see notes below)" Then
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim fName As String
fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"
ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR#"
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
ElseIf Sheet1.Range("G31") = "Multiple applicants registered at the same address" Then
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "JABAAR.ALI#__________ "
.CC = ""
.BCC = ""
.Subject = "RESTRICTED:"
.Body = "Hello," & vbNewLine & vbNewLine
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you, this referral has been sucessfully sent"
End If
End Sub

Resources