Bulk Emails with multiple variations

[ComputerNewbie1992]

Hi All,

I have an idea of what I would like the spreadsheet to do however I have ZERO experience with VBA or coding and I've relied heavily on formulas in the past. I've created an example spreadsheet to try to explain what I'm trying to achieve but basically, I'm looking for a spreadsheet which works as follows:

• Tick boxes of companies you want to send email to - if multiple are ticked, then multiple emails will be sent.
• 'Point of Contact' and 'Date' will be referred to in the email body.
• Press [Send] will provide a draft email which can be checked before sending.
  (In the past I've been unable to populate my default signature, as this will be utilised by different members of my team, I cannot have the signature as part of the email body)

Sorry I can't upload a Mini-sheet as my companies admin permissions are restrictive but I can send a copy of the spreadsheet via email if it'll be helpful.

Thanks in advance
Greg

To:	[Emails addresses associated with Company #]
Cc:	Boss@outlook.com
Subject:	[Generated from Cell]
Email Body:	Hi [Point of Contact], We wanted to let you know about an exciting product which we are looking to release to the market. Please provide your RSVP by [Date] to register your interest Regards [Signature]

 

[ComputerNewbie1992]

Place an "x" (lower case) in column C and run this macro:

Sub CreateEmails()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, fnd As Range, x As Long
    Set OutApp = CreateObject("Outlook.Application")
    For Each rng In Range("C6", Range("C" & Rows.Count).End(xlUp))
        If rng = "x" Then
            Set fnd = Range("J:J").Find(rng.Offset(, -1).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                x = fnd.CurrentRegion.Offset(1).Cells.Count - 1
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
                    .cc = "Boss@outlook.com"
                    .Subject = Range("C2").Value
                    .HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"
                    .Display
                End With
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Thanks Mumps, this is great! Just 1 thing, is there a way for the email to populate my email signature? I've checked Outlook and my signature appears on both new emails and replies - is there a code to pull through my signature?

 

[gordsky]

was about to post a very similar code to above but If you change this section of the code:

With OutMail
        .To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
        .cc = "Boss@outlook.com"
        .Subject = Range("C2").Value
        .HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the       market." & "<br><br><br><br>" & "Regards,"
        .Display
End With

to this

With OutMail
        .display
        signature = newEmail.htmlbody
        .To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
        .cc = "Boss@outlook.com"
        .Subject = Range("C2").Value
        .HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"
        .htmlbody = .htmlbody & signature
end with

it will add the signature of the individual user sending the mail. You will need to "Dim signature as string" also at the start of code. I think if you also change the

.HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"

to

.HTMLBody = rng.Offset(, 3) & "<br><br>" & range("B15").value

it will take the message body from the cell in your worksheet and give the ability to change the message text each time based on what it is you type in the cell of the worksheet (for future proofing as you put it), without having to edit the vba code each time

 

[mumps]

Have a look at this link: Insert Outlook Signature in mail

 

[ComputerNewbie1992]

T

was about to post a very similar code to above but If you change this section of the code:

With OutMail
        .To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
        .cc = "Boss@outlook.com"
        .Subject = Range("C2").Value
        .HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the       market." & "<br><br><br><br>" & "Regards,"
        .Display
End With

to this

With OutMail
        .display
        signature = newEmail.htmlbody
        .To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
        .cc = "Boss@outlook.com"
        .Subject = Range("C2").Value
        .HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"
        .htmlbody = .htmlbody & signature
end with

it will add the signature of the individual user sending the mail. You will need to "Dim signature as string" also at the start of code. I think if you also change the

.HTMLBody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"

to

.HTMLBody = rng.Offset(, 3) & "<br><br>" & range("B15").value

it will take the message body from the cell in your worksheet and give the ability to change the message text each time based on what it is you type in the cell of the worksheet (for future proofing as you put it), without having to edit the vba code each time

Thanks Gordsky,
Sorry I am useless at VBA - how would I add the "Dim signature as string"?

 

[gordsky]

T

Thanks Gordsky,
Sorry I am useless at VBA - how would I add the "Dim signature as string"?

at the very start of mumps code about line 2 or 3 it will say something like 'dim outapp as object'. At the very end of that line just add ",signature as string"

 

[ComputerNewbie1992]

.To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";") .cc = "Boss@outlook.com" .Subject = Range("C2").Value .HTMLBody =

T

Thanks Gordsky,
Sorry I am useless at VBA - how would I add the "Dim signature as string"?

@gordsky - I made the changes you mentioned initally but now it's only showing the Signature, nothing else. I also get a run-time error '424' which says there is an Object required.

Have I done something wrong?

Sub CreateEmails()
Application.ScreenUpdating = False
Dim OutApp As Object, OutMail As Object, rng As Range, fnd As Range, x As Long, Signature As String
Set OutApp = CreateObject("Outlook.Application")
For Each rng In Range("C8", Range("C" & Rows.Count).End(xlUp))
If rng = "x" Then
Set fnd = Range("J:J").Find(rng.Offset(, -1).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
x = fnd.CurrentRegion.Offset(1).Cells.Count - 1
Set OutMail = OutApp.CreateItem(0)
With OutMail
.display
Signature = newEmail.HTMLbody
.To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
.cc = "Boss@outlook.com"
.Subject = Range("C2").Value
.HTMLbody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"
.HTMLbody = .HTMLbody & Signature
End With
End If
End If
Next rng
Application.ScreenUpdating = True
End Sub

 

[gordsky]

@gordsky - I made the changes you mentioned initally but now it's only showing the Signature, nothing else. I also get a run-time error '424' which says there is an Object required.

Have I done something wrong?

Sub CreateEmails()
Application.ScreenUpdating = False
Dim OutApp As Object, OutMail As Object, rng As Range, fnd As Range, x As Long, Signature As String
Set OutApp = CreateObject("Outlook.Application")
For Each rng In Range("C8", Range("C" & Rows.Count).End(xlUp))
If rng = "x" Then
Set fnd = Range("J:J").Find(rng.Offset(, -1).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
x = fnd.CurrentRegion.Offset(1).Cells.Count - 1
Set OutMail = OutApp.CreateItem(0)
With OutMail
.display
Signature = newEmail.HTMLbody
.To = Join(Application.WorksheetFunction.Transpose(Range("J" & fnd.Row + 1).Resize(x).Value), ";")
.cc = "Boss@outlook.com"
.Subject = Range("C2").Value
.HTMLbody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"
.HTMLbody = .HTMLbody & Signature
End With
End If
End If
Next rng
Application.ScreenUpdating = True
End Sub

when it gives you the runtime error if you click debug it should highlight the line of code causing the error. Which line is it

 

[gordsky]

when it gives you the runtime error if you click debug it should highlight the line of code causing the error. Which line is it

change

Signature = newEmail.HTMLbody

to

Signature = outmail.HTMLbody

I can see also that you have the range as "C8" whereas in Mumps code it is "C6" is that correct for your worksheet.

If you want to do what you said origionally and use text stored on the sheet as your email body then you also need to change the

.HTMLbody = rng.Offset(, 3) & "<br><br>" & "We wanted to let you know about an exciting product which we are looking to release to the market." & "<br><br><br><br>" & "Regards,"

to

to .HTMLbody = rng.Offset(, 3) & "<br><br>" & range("B15") & "<br><br><br><br>" & "Regards,"  '<- change the B15 to the cell where your message is located

 

[ComputerNewbie1992]

Thanks @gordsky , it is all working now except the body message is showing as '0'. I don't have the message OR the Point of Contact

 

[gordsky]

Those details come from cells within the sheet so I would guess that the layout of the form isnt as you first posted (I can see it has shifted by 1 cell on each post). Rather than back and forth supply the following info and I will amend the code.

Cell reference for PoC
Cell Reference for the first cell of your email body