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

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.
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).



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

Select all Open in new window