Solved using Mail merge to create 206 emails with different info

June 8, 2017 at 00:54:18
Specs: Windows 10
I have a template email which I'd like to send to 206 people. Im an IT Administrator and want to generate 206 emails pulled from a list of email addresses I have in an excel spreadsheet going down column B. Going down column A are the first and last name of the recipients. I would like to extract into the emails, line by line from the excel separate emails with the persons email address into the TO field, the subject and body is based off of the template, and down column C are the different passwords for each user.

Ive looked at mail merge steps online and always seem to produce varied results, none of which are succesfull. THought of copying a macro but cant find one either. I'm happy to either way but at the moment I dont know which is easier. If anyone could assist I would appreciate it. APologies in advance if I've left out any details to provide. Happy to work through it :)


See More: using Mail merge to create 206 emails with different info

Report •

#1
June 8, 2017 at 01:17:24
✔ Best Answer
Try this code, all you will need to do is open the VBA editor in Excel Either by holding ALT and pressing F11, or by going into the developer tab and clicking on Visual Basic.

In the project explorer window, find the sheet name in which you have your email addresses etc in, in Excel and paste the code there.

To run the code, place the cursor on the line 'Private Sub GenerateEmails()' and press F8 then F5


Dim Bcell As Range ' Define variables
Dim iSubject, iTo, iBody As String

Private Sub GenerateEmails()
    
' Loop through each of the cells from B1 to the last row
    For Each Bcell In Range("B1", Range("B" & Rows.Count).End(xlUp))
        
        ' The subject can be changed to whatever you like
        iSubject = "New Password"
        
        ' If the cell isnt empty then set the variables
        ' iTo will be set to the cell to the left of the current cell
        ' iBody will be a generic text with the password from the cell to the right of the current cell
        
        If Bcell <> Empty Then
            iTo = Bcell
            
            iBody = "Dear " & Bcell.Offset(0, -1) & "," & vbCrLf & vbCrLf _
            & "Your new password is: " & Bcell.Offset(0, 1)
        
            SendEmail
            
        End If
            
        iTo = Empty
        iBody = Empty
    
    Next Bcell
    
End Sub

Private Sub SendEmail()

' This module takes the variables that we set above and then generates the emails
' Note that if you want the emails to be sent immidiately without being displayed
' You can change .dsplay to .send and they will be sent

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
        
    With OutMail
        .To = iTo
        .CC = iCC
        .BCC = ""
        .Subject = iSubject
        .Body = iBody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display 'or use .Send to automatically send without displaying
    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub



Report •

#2
June 8, 2017 at 04:12:36
You lost me at "Passwords." Are you emailing passwords to your users?

Report •

#3
June 8, 2017 at 12:49:45
Yes beachy. Different passwords for each user will need to be emailed

Report •

Related Solutions

#4
June 8, 2017 at 12:51:29
ThAnks alwayswilling I’ll give it a go later looks like it should work

Report •

#5
June 14, 2017 at 23:17:36
thanks for the info alwayswillingtolearn -
1. does the email addresses, passwords, and names all have to be on diffferent worksheets??
2. I have selected the sheet, under "microsoft excel objects", where do i paste the code ??

Report •

#6
June 14, 2017 at 23:57:54
Hi,

1. does the email addresses, passwords, and names all have to be on diffferent worksheets??

No it will be easier if they are all on the same worksheet

2. I have selected the sheet, under "microsoft excel objects", where do i paste the code ??

ok let me try to explain.

Say that all your data email addresses, names, password were on a sheet called "My Data" now once you can see the "Microsoft Excel Object" double click on the sheet called "My Data" and paste the entire code there.

You will now be able to run the code from within the VBA window. If all else fails you can PM me and I will send you my email address you can send me your workbook and I can put the code in for you.


Report •

#7
June 16, 2017 at 00:47:03
Hi bradwinw,

as per your request via PM, I have updated the code so you can now send the passwords in a different colour, in this code I have chosen red. The code works by converting your placeholder tags with the relevant HTML tags.

for example when I want to change the color of some text to red I usually use the tag

Open tag
<f>

close tag
</f>

Then when I call my convertor it will then swap these tags with the correct html tags and set the colour to red.

Dim iSubject, iTo, iBody As String
Dim Bcell As Range
Dim iHTMLBody As String

Private Sub GenerateEmails()
    iBody = ""
' Loop through each of the cells from B1 to the last row
    For Each Bcell In Range("B1", Range("B" & Rows.Count).End(xlUp))
        
        ' The subject can be changed to whatever you like
        iSubject = "New Password"
        
        ' If the cell isnt empty then set the variables
        ' iTo will be set to the cell to the left of the current cell
        ' iBody will be a generic text with the password from the cell to the right of the current cell
        
        If Bcell <> Empty Then
            iTo = Bcell
            
            iBody = "Dear " & Bcell.Offset(0, -1) & "," & vbCrLf & vbCrLf _
            & "Your new password is: " & "<f>" & Bcell.Offset(0, 1) & " </f>"
            
            iBody = ReplaceCRLFwithBR(iBody)
            
            
            If (InStr(iBody, "<font>") = 0) Then
                iBody = FormatAsHtml(iBody)
            End If
            
            SendEmail
            
        End If
            
        iTo = Empty
        iBody = Empty
    
    Next Bcell
    
End Sub

Public Function ReplaceCRLFwithBR(ByVal strText) As String
'=================================================================
'Replace all vbcrlf with 
 to keep line breaks in html emails
'Replace all other tags to their to html tags
'=================================================================

strText = Replace(strText, Chr(13), "
")
strText = Replace(strText, Chr(10), "")

strText = Replace(strText, "<f>", "<font>")
strText = Replace(strText, "</f>", "</font>")

ReplaceCRLFwithBR = strText

End Function

Public Function FormatAsHtml(ByVal str) As String
'=================================================================
'Wraps a string in html tags
'=================================================================

FormatAsHtml = "<html><font face="" size="">" & str & "</font></html>"


End Function

Private Sub SendEmail()

' This module takes the variables that we set above and then generates the emails
' Note that if you want the emails to be sent immidiately without being displayed
' You can change .dsplay to .send and they will be sent

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
        
    With OutMail
        .To = iTo
        .CC = iCC
        .BCC = ""
        .BodyFormat = olFormatHTML
        .HTMLBody = iBody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display 'or use .Send to automatically send without displaying
    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub


Report •

#8
June 22, 2017 at 00:46:46
Hi ,

try this new code, for some reason the previous code had an error even though I copied it from a working workbook, hmmmm

Dim iSubject, iTo, iBody As String
Dim Bcell As Range
Dim iHTMLBody As String

Private Sub GenerateEmails()
    iBody = ""
' Loop through each of the cells from B1 to the last row
    For Each Bcell In Range("B1", Range("B" & Rows.Count).End(xlUp))
        
        ' The subject can be changed to whatever you like
        iSubject = "New Password"
        
        ' If the cell isnt empty then set the variables
        ' iTo will be set to the cell to the left of the current cell
        ' iBody will be a generic text with the password from the cell to the right of the current cell
        
        If Bcell <> Empty Then
            iTo = Bcell
            
            iBody = "Dear " & Bcell.Offset(0, -1) & "," & vbCrLf & vbCrLf _
            & "Your new password is: " & "<f>" & Bcell.Offset(0, 1) & "</f>"
            
            iBody = ReplaceCRLFwithBR(iBody)
            
            
            If (InStr(iBody, "<font>") = 0) Then
                iBody = FormatAsHtml(iBody)
            End If
            
            SendEmail
            
        End If
            
        iTo = Empty
        iBody = Empty
    
    Next Bcell
    
End Sub

Public Function ReplaceCRLFwithBR(ByVal strText) As String
'=================================================================
'Replace all vbcrlf with
' to keep line breaks in html emails
'Replace all other tags to their to html tags
'=================================================================

strText = Replace(strText, Chr(13), "")
strText = Replace(strText, Chr(10), "")

strText = Replace(strText, "<f>", "<font color=#FF0000>"
strText = Replace(strText, "</f>", "</font>")

ReplaceCRLFwithBR = strText

End Function

Public Function FormatAsHtml(ByVal str) As String
'=================================================================
'Wraps a string in html tags
'=================================================================

FormatAsHtml = "<html><font face="" size="">" & str & "</font></html>"


End Function

Private Sub SendEmail()

' This module takes the variables that we set above and then generates the emails
' Note that if you want the emails to be sent immidiately without being displayed
' You can change .dsplay to .send and they will be sent

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
        
    With OutMail
        .To = iTo
        .CC = iCC
        .BCC = ""
        .BodyFormat = olFormatHTML
        .HTMLBody = iBody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display 'or use .Send to automatically send without displaying
    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub





Report •

Ask Question