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
Related
I tried all the different solutions to this question: How to add default signature in Outlook.
I did not find that any worked with what I have built.
I'm working with an adaptation of Ron de Bruin's email template worksheet where the email body and recipient are referencing another table.
I am either getting the email body correctly formatted (new-line delimited) with broken signature (containing links and images) OR correct signature but the email body is not properly formatted.
The following shows the signature correctly, but the email body is not properly formatted.
On Error Resume Next
Set olApp = Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.display
End With
signature = olMail.HTMLbody
With olMail
signature = olMail.HTMLbody
.To = StringTo
.CC = StringCC
.BCC = StringBCC
.Subject = Me.Cells(myCell.Row, "I").Value
.HTMLbody = strHTMLBody & Me.Cells(myCell.Row, "K").Value & signature
Give a try to below sub. The sub will display mail with default signature and you can add body message as well as attachment as per your need.
Sub SendMailWithDefaultSign()
On Error GoTo HarunErrHandler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim strAttachment As Variant, strSubject As Variant, strBody As Variant
Dim strEmail As String
Dim fileName As String
strSubject = "VBA code to send mail with default signature." 'Me.TaskID & ": " & Me.TaskTitle
'strBody = Me.Description
strEmail = "recipientmail#domain.com"
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
.BodyFormat = olFormatHTML
.Display
.Recipients.Add strEmail
.Subject = strSubject
.HTMLBody = "<b>Hello Everyone,</b><br>" & _
"Please cehck the attached file.<br>" & .HTMLBody
' .Attachments.Add fileName
End With
Exit Sub
HarunErrHandler:
MsgBox "Error :" & Err.Number & ", " & Err.Description, vbInformation, "Error"
End Sub
You need to make sure a well-formatted HTML string is assigned to the HTMLBody property. So, if you want to insert anything before the signature you need to find an opening <body> tag and paste your string there right after the <body> tag.
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
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."
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.
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