<

Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x

Mailmerge using Visual Basic, MS Excel 2010 and MS Outlook 2010

Published on
7,768 Points
3,668 Views
1 Endorsement
Last Modified:
Thomas Zucker-Scharff
Veteran in computer systems, malware removal and ransomware topics.  I have been working in the field since 1985.
It started out where I was asked to do something fairly simple. My boss asked if I could do a simple mail merge with separate attachments for each email.  It sounded easy and then I tried it.
 
First I found some help doing it with MS Word and Outlook. This looked promising at first. That is until it just didn't work.  There were a couple of helpful articles and macros.  This one by coachjim on Experts Exchange got me started.  It pointed me to the eventual script I tried out at Doug Robbins' page.  Which pointed me to the ClickYes program on this page.  It turned out that no matter what I did, I kept getting an error returned saying "0 documents sent." This was rather annoying since it didn't indicated why.  I continued to try to find a method to do this mailmerge. I searched Experts Exchange again (the same way I found the article by Coachjim) and this time I found that a user called Nick67 had posted several answers to similar questions, although his answers tended to be about using MS Access to do a mailmerge.

This began a messaging conversation that includes 25 exchanges and concluded in my being able to execute the mailmerge using some macro code in visual basic in MS Excel which generates Outlook emails and sends them.  This works so well I am currently developing it to be more user friendly and generic so that others can just answer a few questions and they will be able to generate what ever emails they wish.
So thanks Nick!!!

If you are interested my VBA code in excel looks like this (I confess that I did not write most of this):

Option Explicit
Public WasOpen As Boolean
Private Function FireOutlook() As Object
On Error Resume Next
Dim objOutlook As Object

Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
    Err.Clear
    WasOpen = False
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
Else
    WasOpen = True
End If
Set FireOutlook = objOutlook
End Function


Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim TheFile As String
Dim x As Integer
Dim StartRow As String ' oroginally this was set to Integer - I figured there was a problem when I started getting a data type mismatch
Dim EndRow As String
Dim Name As String
Name = InputBox("Please enter the name of the worksheet that contains the data to be emailed:", "Name of worksheet", "Members") ' the default is set to the "Members" worksheet

Set OutApp = FireOutlook()
OutApp.Session.Logon

StartRow = InputBox("Start at what row in the worksheet?", "Start", 1) ' set default to 1
If StartRow = "" Or IsNumeric(StartRow) = False Then Exit Sub
EndRow = InputBox("End at what row in the worksheet?", "End", 1) ' set default to 1
If EndRow = "" Or IsNumeric(EndRow) = False Then Exit Sub

For x = CInt(StartRow) To CInt(EndRow)
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
    .To = Worksheets(Name).Cells(x, 1) 'Row x, Column A
    .CC = ""
    .BCC = ""
    .Subject = Worksheets(Name).Cells(x, 3) 'Row x, Column C
    ' greeting using nickname
    .HTMLBody = "Dear " & Worksheets(Name).Cells(x, 18) & "," 'Row x, Column R
    ' first paragraph of letter
    .HTMLBody = .HTMLBody & Worksheets(Name).Cells(x, 8).Value 'Row x, Column H
    ' attach the previous years survey or a blank
    .Attachments.Add Worksheets(Name).Cells(x, 2).Value 'Row x, Column B
    ' attach this years facility usage table or a blank
    .Attachments.Add Worksheets(Name).Cells(x, 17).Value 'Row x, Column Q
    .display
    '.Send
    End With
    Set OutMail = Nothing
Next x
 

Set OutApp = Nothing
 
 End Sub


This was a real doosey of a task and although I had asked a question here on how to go about this, the real answer came from Nick67 (and the important parts of the code).

So if you are doing something similar, I'll be glad to help with whatever I can, but know that I am not the real expert when it comes to doing mailmerges.

Now the average user is going to ask "How do I go about setting this up to work on my own computer with my own variables?"  Some of this I have tried to take into consideration by having the script ask for what you want to do.  Other parts are not as clear.  For instance, I used aWindows 7 Professional 64 bit box with clickYes demo version installed and trusted the excel document as well as saved it as a macro enabled document in Excel 2010 (.xlsm).  I thought this would transfer rather easily to my laptop I use for work projects away from the office.  It runs Windows 8.1 Pro and does not have the network drives that the original script points to and doesn't have clickYes installed.  When I tried to run the script from there, I was unable to get it to even get past the first line of generating the email - the TO field.  Although a message box (MsgBox) command from the script shows that it detects the correct field, it still doesn't know how to deal with it properly.

After I added a message box to the script I saw this message, which indicated that the script was seeing an email address in the row and column indicated.
excel-script-shows-email-address-before-After pressing okay I see this dialog which indicates there is a problem with the To method in the script and since the email is being read correctly above, it must be something else. (Porting this script is not as easyas I thought it would be).


excel-script-throws-error-on-windows-8.P
I have not found a solution to this yet, but will repost when I do.  There are enough postings on the web about problems in either Microsoft update or something breaking the ability for VBA scripts to execute in the same way in Windows 7 and in Windows 8 that I am fairly sure I will find a solution.

UPDATE1: I haven't found a solution to the windows 8 problem yet (but see below for Nick's comment).  I did both alter the script and create a generic one.  I am inserting (because I couldn't figure out how to attach it) the generic script which is one button execution excel spreadsheet.  It has a sample sheet (Sheet1) that shows what fields should be put where and which can be edited.  The first sheet of this spreadsheet has only a button on it that says click to send email.  If you want see how to add a command button, check out this page from microsoft: https://support.office.com/en-in/article/Add-a-button-and-assign-a-macro-to-it-in-a-worksheet-d58edd7d-cb04-4964-bead-9c72c843a283.
 
Option Explicit
Public WasOpen As Boolean
Private Function FireOutlook() As Object
On Error Resume Next
Dim objOutlook As Object

Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
    Err.Clear
    WasOpen = False
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
Else
    WasOpen = True
End If
Set FireOutlook = objOutlook
End Function


Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim TheFile As String
Dim x As Integer
Dim StartRow As String
Dim EndRow As String
Dim WrkshtName As String
Dim GreetingName As Integer
Dim MessageBody As String
Dim SubjectText As String
Dim Signature As Integer
Dim Attachment1 As Integer
Dim Attachment2 As Integer
Dim FullPathToAttachment1 As Integer
Dim FullPathToAttachment2 As Integer
Dim CloseName As String
Dim CloseString As String
Dim MailSender As String
'Dim Wrksht As Worksheet
'Dim StartCell As String
'Dim Attachment2Inc As String

WrkshtName = InputBox("Please enter the Name of the worksheet that contains the data to be emailed:", "Name of worksheet", "Sheet1")
SubjectText = InputBox("Enter the subject line of the email", "Subject Line:", "Subject of Email")
CloseString = InputBox("Enter the close word(s) that will appear in the complimentary close of the message here:", "Complimentary closure", "Sincerely,")
CloseName = InputBox("Enter the name that will appear in the complimentary close of the message here:", "Name after Sincerely", "David")
'Attachment2Inc = InputBox("Do you have a second attachment", "Second Attachment?", "yes")

MsgBox ("Note that for the rest of the inputs you can use the defaults if you follow the excel template when entering information")

Set OutApp = FireOutlook()
OutApp.Session.Logon

' convert excel lettered column to number
Dim InputLetter As String
Dim OutputNumber As Integer
Dim Leng As Integer
Dim i As Integer

InputLetter = InputBox("Please enter the column of the worksheet - column letter - in which the Name you wish to use as a greeting appears:", "Greeting Name", "E")  ' Input the Column Letter
Leng = Len(InputLetter)
OutputNumber = 0


For i = 1 To Leng
   OutputNumber = (Asc(UCase(Mid(InputLetter, i, 1))) - 64) + OutputNumber * 26
Next i
' end convert subroutine
GreetingName = OutputNumber

' convert excel lettered column to number
Dim InputLetter2 As String
Dim OutputNumber2 As Integer
Dim Leng2 As Integer
Dim i2 As Integer

InputLetter2 = InputBox("Please enter the column of the worksheet - column letter - in which the Signature you wish to use appears:", "Signature Column", "M")  ' Input the Column Letter
Leng2 = Len(InputLetter2)
OutputNumber2 = 0


For i2 = 1 To Leng2
   OutputNumber2 = (Asc(UCase(Mid(InputLetter2, i2, 1))) - 64) + OutputNumber2 * 26
Next i2
' end convert subroutine
Signature = OutputNumber2

' convert excel lettered column to number
Dim InputLetter3 As String
Dim OutputNumber3 As Integer
Dim Leng3 As Integer
Dim i3 As Integer

InputLetter3 = InputBox("Please enter the column of the worksheet - column letter - in which the name of first attachment you wish to use is stored:", "First Attachment Column", "B")  ' Input the Column Letter
Leng3 = Len(InputLetter3)
OutputNumber3 = 0


For i3 = 1 To Leng3
   OutputNumber3 = (Asc(UCase(Mid(InputLetter3, i3, 1))) - 64) + OutputNumber3 * 26
Next i3
' end convert subroutine
Attachment1 = OutputNumber3

' convert excel lettered column to number
Dim InputLetter4 As String
Dim OutputNumber4 As Integer
Dim Leng4 As Integer
Dim i4 As Integer

InputLetter4 = InputBox("Please enter the column of the worksheet - column letter - in which the name of second attachment you wish to use is stored:", "Second Attachment Column", "G")  ' Input the Column Letter
Leng4 = Len(InputLetter4)
OutputNumber4 = 0


For i4 = 1 To Leng4
   OutputNumber4 = (Asc(UCase(Mid(InputLetter4, i4, 1))) - 64) + OutputNumber4 * 26
Next i4
' end convert subroutine
Attachment2 = OutputNumber4

' convert excel lettered column to number
Dim InputLetter6 As String
Dim OutputNumber6 As Integer
Dim Leng6 As Integer
Dim i6 As Integer

InputLetter6 = InputBox("Please enter the column of the worksheet - column letter - in which the path to the first attachment you wish to use is stored:", "First Attachment Path Column", "P")  ' Input the Column Letter
Leng6 = Len(InputLetter6)
OutputNumber6 = 0


For i6 = 1 To Leng6
   OutputNumber6 = (Asc(UCase(Mid(InputLetter6, i6, 1))) - 64) + OutputNumber6 * 26
Next i6
' end convert subroutine
FullPathToAttachment1 = OutputNumber6

' convert excel lettered column to number
Dim InputLetter5 As String
Dim OutputNumber5 As Integer
Dim Leng5 As Integer
Dim i5 As Integer

InputLetter5 = InputBox("Please enter the column of the worksheet - column letter - in which the path to the second attachment you wish to use is stored:", "Second Attachment Path Column", "O")  ' Input the Column Letter
Leng5 = Len(InputLetter5)
OutputNumber5 = 0


For i5 = 1 To Leng5
   OutputNumber5 = (Asc(UCase(Mid(InputLetter5, i5, 1))) - 64) + OutputNumber5 * 26
Next i5
'If Attachment2Inc = "yes" Then OutputNumber5 = ""

' end convert subroutine
FullPathToAttachment2 = OutputNumber5

StartRow = InputBox("Start at what row in the worksheet?", "Start", 10)
If StartRow = "" Or IsNumeric(StartRow) = False Then Exit Sub
EndRow = InputBox("End at what row in the worksheet?", "End", 10)
If EndRow = "" Or IsNumeric(EndRow) = False Then Exit Sub

'Set Wrksht = Sheets(WrkshtName)
'StartCell = "A" & StartRow
'Wrksht.Range (StartCell)

For x = CInt(StartRow) To CInt(EndRow)
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
    '.To = "tzs@cyberdude.com" ' This code makes it work with windows 8 when uncommented (WrkshtName is not being processed correctly)
    .To = Worksheets(WrkshtName).Cells(x, 1) 'Row x, Column A
    .CC = ""
    .BCC = ""
    .Subject = SubjectText
    ' greeting using nick Name
    .HTMLBody = "Dear " & Worksheets(WrkshtName).Cells(x, GreetingName) & "," 'Row x, Column R
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 9).Value 'Row x, Column I
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line using tr and td
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 18).Value ' message body
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line again
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line again
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 10).Value ' before closure
    .HTMLBody = .HTMLBody & CloseString ' sincerely yours,
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 11).Value ' html before name
    .HTMLBody = .HTMLBody & CloseName ' name
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 12).Value ' end of html of closure
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 13).Value ' full signature
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 14).Value ' end of html
    ' attach the previous years survey or a blank
    .Attachments.Add Worksheets(WrkshtName).Cells(x, Attachment1).Value 'Row x, Column B
    ' attach this years facility usage table or a blank
    .Attachments.Add Worksheets(WrkshtName).Cells(x, Attachment2).Value 'Row x, Column F
    .display
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "%s"
    '.Send
    End With
    Set OutMail = Nothing
Next x
 

Set OutApp = Nothing
 
 End Sub

Open in new window


1
Comment
  • 2
  • 2
4 Comments
 
LVL 26

Expert Comment

by:Nick67
You have a nice, big, ugly Windows error there, and not a VBA error.
That makes me suspect that you either don't have Outlook installed on the Win 8.1, or you haven't yet fired up Outlook and created a profile.  The code automates Outlook from Excel, but look at it's structure!  It is setup ONLY deal with the 429 error that occurs when Outlook is open/not open

Option Explicit
 Public WasOpen As Boolean
 Private Function FireOutlook() As Object
 On Error Resume Next 'on any error keep going!
 Dim objOutlook As Object
Set objOutlook = GetObject(, "Outlook.Application") 'this line 'gets' an open Outlook object
'a 429 error will occur is Outlook is presently closed
'the next line is commented out
'turn it back on to catch and troubleshoot different errors
 'MsgBox Err.Number & " " & Err.Description
 If Err.Number = 429 Then 'deal with a 429 error -- but what if it is not 429!
     Err.Clear
     WasOpen = False
     ' Create the Outlook session.
     Set objOutlook = CreateObject("Outlook.Application")
 Else 'if there was no error, or an error other than 429 we'll get here
     WasOpen = True
'but there's no code to deal with any kind of a different error, so if something OTHER THAN a 429 happens... we'll send out an non-existent object and the BANG! will happen in the calling code.
 End If
 Set FireOutlook = objOutlook
 End Function

Open in new window


Nick67
0
 
LVL 30

Author Comment

by:Thomas Zucker-Scharff
Thanks Nick.  I will try that, but Outlook is already setup and I can get and send email using it.  I'll uncomment the lines and see what happens.
0
 
LVL 30

Author Comment

by:Thomas Zucker-Scharff
I created a generic script with a command button to launch it, but was unable to attach the file in the article.  Here is the file with the command button o initiate the script, a directions tab to describe usage and an acknowledgements tab because I had so much help.
generic-email.xlsm
0
 
LVL 26

Expert Comment

by:Nick67
OutApp.Session.Logon
That, I've never seen before.
The stuff I work with is a bit more involved.
I don't just fire up an Outlook object before I start working with the message.
I get the namespace, the Explorer and the Inbox folder sorted, too.
I have a reference to Outlook set (early binding)
So, after FireOutlook returns an Outlook.Application object and sets wasOpen either true or false, the following code comes, and then I start working with the MailItem

Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers
    
If wasOpen = False Then
    objOutlook.Explorers.Add Folder
    Folder.Display
    'done opening
End If

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

'...the rest of the code for creating a message

Open in new window

0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Join & Write a Comment

This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month