Excel VBA attaching emails within an email - excel

I am working on a project where I need to "draft" 5 emails, attach them to another email, and then send this nested email to a coworker.
My issue is that the 5 attached emails do not show a subject line. I wrote a little tester where the subject lines are also lost during the attaching
Private Sub emailtest()
'Declare Variables
Dim EmailMain As Outlook.MailItem
Dim EmailSub As Outlook.MailItem
Dim j As Long
'Create the main email object
Set EmailMain = Outlook.CreateItem(olMailItem)
With EmailMain
.To = "fake#fakeemail.org"
.Subject = "Testing Main"
.Body = "testing testing"
End With
'creating 5 email objects
For j = 1 To 5
'Create the sub email to be attached to the main email
Set EmailSub = Outlook.CreateItem(olMailItem)
'Details for this sub email
With EmailSub
.To = ""
.Subject = "Test: " & j
.Body = "Testing Nest: " & j
End With
'Attach the email to the main email
EmailMain.Attachments.Add EmailSub
Next j
EmailMain.Display
End Sub
After running this the displayed email has 5 emails, but they are all blank. No subject, no body, nothing.
Any help is appreciated.

You need to save the message being added as an attachment before it is attached:
EmailSub.Save
EmailMain.Attachments.Add EmailSub

Related

Compile error: Variable not defined in VBA

I'm using VBA to make automating emails from Excel to outlook however when I'm running my code it show compile error: variable not defined
I'm trying using from this source : https://beebole.com/blog/automating-emails-from-excel-employee-bonus/#copy
But, I only use Name, First Name, Send To, Email Subject, Email Body and Single-Send Link. For my Email Subject and Email Body I don't use any formula.
This my code in VBA
MY table for single-send link having an error
Formula in excel :
=HYPERLINK(“mailto:“&[#[Send To]]&”?subject=”&[#[Email Subject]]&”&body=”&[#[Email Body]],”SEND”)
[
Sub EmailAll()
Dim oApp As Object
Dim oMail As Object
Dim SendToName As String
Dim theSubject As String
Dim theBody As String
For Each c In Selection 'loop through (manually) selected records
'''For each row in selection, collect the key parts of
'''the email message from the Table
SendToName = Range("C" & c.Row)
theSubject = Range("D" & c.Row)
theBody = Range("E" & c.Row)
'''Compose emails for each selected record
'''Set object variables.
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
'''Compose the customized message
With oMail
.To = SendToName
.Subject = theSubject
.Body = theBody
''' If you want to send emails automatically, use the Send option.
''' If you want to generate draft emails and review before sending, use the Display option.
''' Do not use both!
'''To activate your chosen option: Remove the single quote from the beginning of the code line, then
'''add the single quote back to the option you didn't choose
.Display
'.Send
End With
Next c
End Sub
Can anyone help me to solve this problem

How to send mass emails in Excel?

This is how the message should look in the email:
This is my Excel sheet:
I have an Excel file with columns from A to M, A being Payer, and M being the email address. I need a macro to sort by email address and create an email with the data associated with that email address.
I need a message on the email that reads:
Hello team,
Please review the items below and provide your comments for the invoices due in the account regarding payment details, let us know if there is additional information needed from our end so that we can send it as soon as possible.
That message would have to be able to be changed and my signature at the end.
The data on the columns is:
A Payer
B Name
C Invoice Number
D Bill. Date
E Net due date
F Days past due
G Aging
H Value
I Cust. Mat.
J PO Number
K Bill.Doc.
L Delivery
M Email
I would like to be able to check the emails before sending them.
This is a handy piece of code that includes your default signature in an email.
It is also possible to add attachements (just to keep in mind). You will need to play with it using the .diplay property until it looks pretty and the info you need included is all being pulled in correctly.
You can then create another sub to to iterate though each line of data you have and send those emails.
Option Explicit
Sub EmailIncludingSignature()
Dim eSubject As String
Dim eRecipient As String
Dim eBody As String
Dim SAVELOC As String
Dim objOutlook As Object
Dim objEmail As Object
Dim objAttachment As Object
Dim S As String
'Setup Email
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
'Set objAttachment = objEmail.Attachments
'objAttachment.Add SAVELOC & ".pdf"
'Email Signature
S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
'Email parameters
eSubject = "Test Email Signature"
eRecipient = "cameron.critchlow#westinbearmountain.com"
eBody = "" & _
"<br>Hi All,<br><br>" & _
"Last line,<br><br>" & S
'Build Email
With objEmail
.To = eRecipient
.CC = ""
.BCC = ""
.Subject = eSubject
.BodyFormat = olFormatHTML ' send plain text message
.HTMLBody = eBody
.Display
'.Send
End With
End Sub
Do you have experience with VBA? does the above make sense?

VBA send email in outlook 2016 efficiency worsened?

There is a simple piece of standard VBA code that I use to send emails by looking through a list and generating around 2000 email to the draft folder. In my old version of excel & outlook 2012, it took only around 20 min or less to generate all. But after migrated to versions of 2016, the same piece of code take up to 4 hour. Is there any way to speed it up? Thanks!
Function CreateEmail(ToSend As String, ccs As String) As Integer
Dim olapp As Outlook.Application
Dim olemail As Outlook.MailItem
Dim OutlookTemplate As String
OutlookTemplate = "TemplatePath.oft"
Set olapp = New Outlook.Application
Set olemail = olapp.CreateItemFromTemplate(OutlookTemplate)
Dim recipientCheck As Outlook.recipient
With olemail
.HTMLBody ="Body String"
.SentOnBehalfOfName = "sender email address"
.Subject = "subject string"
.To = ToSend
.CC = ccs
.Attachments.Add "attachment.pdf" ' pdf size is 200k
'this is a check for tosend email addresses,
'already tried remove this piece of code, no significant improvement there
Dim recipient As Variant
Dim i, j As Integer
For Each recipient In .recipients
recipient.Resolve
Next
.Save
End With
CreateEmail = 1
End Function
Of course, in the code each time you create a new Outlook Application instance. You can optimize the codebase by extracting such pieces into separate methods (outer) that may call the CreateEmail multiple times only for creating items.
Dim olapp As Outlook.Application
Set olapp = New Outlook.Application
Function CreateEmail(app as Outlook.Application, ToSend As String, ccs As String) As Integer
Dim olemail As Outlook.MailItem
Dim OutlookTemplate As String
OutlookTemplate = "TemplatePath.oft"
Dim recipientCheck As Outlook.recipient
Set olemail = olapp.CreateItemFromTemplate(OutlookTemplate)
With olemail
.HTMLBody ="Body String"
.SentOnBehalfOfName = "sender email address"
.Subject = "subject string"
.To = ToSend
.CC = ccs
.Attachments.Add "attachment.pdf" ' pdf size is 200k
'this is a check for tosend email addresses,
'already tried remove this piece of code, no significant improvement there
Dim recipient As Variant
Dim i, j As Integer
For Each recipient In .recipients
recipient.Resolve
Next
.Save
End With
CreateEmail = 1
End Function
You may also find the following articles helpful:
How To: Create and send an Outlook message programmatically
How to create and show a new Outlook mail item programmatically: C#, VB.NET
How To: Create a new Outlook message based on a template
How To: Fill TO,CC and BCC fields in Outlook programmatically

Taking input for a VBA script

I've a vba script which emails certain cell range values to particular people. but the problem is I've to edit the body of email every time I need to change something. Is there a way in which I can add a field like : "Enter the email address=" and I could enter the email and the script in the back end take that mail address and I'll be able to send it.
Set CH = ActiveChart CH.Parent.Name = "Rishab"
ActiveSheet.ChartObjects("Rishab").Height = RNG.Height
ActiveSheet.ChartObjects("Rishab").Width = RNG.Width
RNG.CopyPicture xlScreen, xlBitmap CH.Paste CH.Export "P:\ABC.png"
esubject = "Shift Handover_Night"
sendto = "ISHelpdeskTeam#appvion.com"
Set app = CreateObject("outlook.application")
Set itm = app.CreateItem(0)
With itm
.Subject = esubject
.To = sendto
.CC = ccto
.HTMLBody = "<img src='P:\ABC.png'/> <br> <br> Thank You <br> Regards <br> Helpdesk"
.Display
.send
End With
Set app = Nothing
Set itm = Nothing
You could use an input box to prompt the user.
EmailAddress = InputBox("Enter the email address")

Unable to send file attachment named in Excel cell

I'm somewhat new to VBA programming so please bear with me. I'm trying to automate the job of emailing my organization's department heads with a standard email but a personalized audit memos. Each email sent to a certain person should also contain the corresponding attachment.
I have a spreadsheet with three columns: name, email address, and the location of the file I'd like to attach in A, B, and C respectively. I've represented this the best I can below.
A....................B..................C
Name.............Email............Attachment
John Smith.....a#b.com.....Q:\PLIU\File1
Jane Smith.....c#d.com.....Q:\PLIU\File2
Jimm Smith.....e#f.com.....Q:\PLIU\File3
This is the code I have so far but I cannot figure out how to attach the file written into the attachment column, as debug gives me "Cannot find this file. Verify the path and filename are correct."
Sub AttachSend()
Dim objMail As Outlook.MailItem
Dim intX As Integer
Dim FileCount As Integer
Dim MailAttachment As String
Dim MailAddress As String
FileCount = Application.WorksheetFunction.CountA(Range("C2:C200"))
For intX = 1 To FileCount
MailAttachment = Application.Cells(intX, 3).Value
MailAddress = Application.Cells(intX, 2).Value
Set objMail = Outlook.Application.CreateItem(olMailItem)
objMail.Subject = "My subject line"
objMail.Body = "My message body"
objMail.To = MailAddress
objMail.Attachments.Add "MailAttachment"
objMail.Send
Set objMail = Nothing
Next
End Sub
Thanks in advance!
Remove the quotes around "MailAttachment". You want to use the MailAttachment variable, but currently you're using the string "MailAttachment", which of course does not exist as a file on disk.
MailAttachment = Application.Cells(intX, 3).Value
MailAddress = Application.Cells(intX, 2).Value
Set objMail = Outlook.Application.CreateItem(olMailItem)
objMail.Subject = "My subject line"
objMail.Body = "My message body"
objMail.To = MailAddress
objMail.Attachments.Add MailAttachment `Remove quotes on this line

Resources