Creating mailmerge from excel using VBA

[jdhfch]

Hi there,

Please can someone help me?

I have created (found on google) a code to create amailmerge from excel using a Macro. I am an absolute novice with VBA so pleasego slow!

The code is:

Dim Outlook As Object
Dim Email As Object
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim address As Range, rngCell As Range
Dim Recipients As String
Dim Lr As Integer
Dim i As Integer
Dim msg As String
Set ws = Sheets("Data") ' Your data sheet.
Set ws1 = Sheets("MailMerge")
Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lr
Set Outlook = CreateObject("Outlook.Application")
Set Email = Outlook.CreateItem(0)

msg = ""
msg = msg & "Dear " &Christian_Name_for_Mail_Merge & "," & vbCrLf & vbCrLf

msg = msg & "I would like to send you an update(blah, blah!)." & vbCrLf & vbCrLf

msg = msg & "The following is an overview of your progress(blah, blah):" & vbCrLf & vbCrLf

msg = msg & "Account Number: " & Account_Number & vbCrLf& vbCrLf
msg = msg & "Account Name: " & Account_Name & vbCrLf& vbCrLf
msg = msg & "Target: " & Target & vbCrLf& vbCrLf
msg = msg & "Turnover to date: " & Turnover_To_Date & vbCrLf& vbCrLf
msg = msg & "Remainder to do " & To_Do & vbCrLf &vbCrLf


msg = msg & "I will continue to update you on amore regular basis, as the end of the period approaches" & vbCrLf& vbCrLf

msg = msg & "Kind Regards" & vbCrLf &vbCrLf
Email.Importance = 2
Email.Subject = "Update"
Email.Body = msg
'Email.Attachments.Add ActiveWorkbook.FullName
'Set Recipient
Email.To = Email_for_Mail_Merge
Email.Send

End If
Next
MsgBox "Email Sent Successfully"
End Sub


Sub MailMerge()
End Sub

When I run this it errors on line 10 Set ws =Sheets("ABMVersion") ' Your data sheet. With the error “ComplieError: invalid outside procedure”

Please can anyone help with this and any other potentialerrors/Improvements?

 

[Norie]

Looks like Sub MailMerge is in the wrong place.

Try this.

Sub MailMerge()
Dim Outlook As Object
Dim Email As Object
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim address As Range, rngCell As Range
Dim Recipients As String
Dim Lr As Long
Dim i As Long
Dim msg As String

    Set ws = Sheets("Data") ' Your data sheet.
    
    Set ws1 = Sheets("MailMerge")
    
    Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To Lr
    
        Set Outlook = CreateObject("Outlook.Application")
        Set Email = Outlook.CreateItem(0)
        
        msg = ""
        msg = msg & "Dear " & Christian_Name_for_Mail_Merge & "," & vbCrLf & vbCrLf
        
        msg = msg & "I would like to send you an update(blah, blah!)." & vbCrLf & vbCrLf
        
        msg = msg & "The following is an overview of your progress(blah, blah):" & vbCrLf & vbCrLf
        
        msg = msg & "Account Number: " & Account_Number & vbCrLf & vbCrLf
        msg = msg & "Account Name: " & Account_Name & vbCrLf & vbCrLf
        msg = msg & "Target: " & Target & vbCrLf & vbCrLf
        msg = msg & "Turnover to date: " & Turnover_To_Date & vbCrLf & vbCrLf
        msg = msg & "Remainder to do " & To_Do & vbCrLf & vbCrLf
        
        
        msg = msg & "I will continue to update you on amore regular basis, as the end of the period approaches" & vbCrLf & vbCrLf
        
        msg = msg & "Kind Regards" & vbCrLf & vbCrLf
        Email.Importance = 2
        Email.Subject = "Update"
        Email.Body = msg
        'Email.Attachments.Add ActiveWorkbook.FullName
        'Set Recipient
        Email.To = Email_for_Mail_Merge
        Email.Send
        
        End If
        
    Next i
    
    MsgBox "Email Sent Successfully"
    
End Sub

 

[jdhfch]

Thank you for helping.

It has now moved on, but I am now getting error Compile Error End if without block if

I am using

Sub MailMerge()
Dim Outlook As Object
Dim Email As Object
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim address As Range, rngCell As Range
Dim Recipients As String
Dim Lr As Integer
Dim i As Integer
Dim msg As String

Set ws =Sheets("Data") ' Your data sheet.

Set ws1 =Sheets("MailMerge")

Lr =ws.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To Lr

Set Outlook =CreateObject("Outlook.Application")
Set Email =Outlook.CreateItem(0)

msg =""
msg = msg & "Dear " &Christian_Name_for_Mail_Merge & "," & vbCrLf & vbCrLf

msg = msg& " I would like to send you an update(blah, blah!)." &vbCrLf & vbCrLf

msg = msg& " The following is an overview of your progress(blah, blah):"& vbCrLf & vbCrLf

msg = msg& "Account Number: "& Account_Number & vbCrLf & vbCrLf
msg = msg& "Account Name: "& Account_Name & vbCrLf & vbCrLf
msg = msg& "Target: "& Target & vbCrLf & vbCrLf
msg = msg& "Turnover to date: "& Turnover_To_Date_ABM_update_with_Vlookup & vbCrLf & vbCrLf
msg = msg& "Remainder to do "& To_Do & vbCrLf & vbCrLf


msg = msg& "I will continue to update you on a more regular basis, as the endof the period approaches" & vbCrLf & vbCrLf

msg = msg& "Kind Regards" & vbCrLf & vbCrLf
Email.Importance = 2
Email.Subject= "Update"
Email.Body =msg
'Email.Attachments.Add ActiveWorkbook.FullName
'Set Recipient
Email.To =Email_for_Mail_Merge
Email.Send

End If

Next i

MsgBox "EmailSent Successfully"
End Sub

 

[Norie]

I think you might need to go back to the source as it's not clear where the missing 'If' should go, or what it's checking for.

Also, some of that code isn't quite right anyway.

For example, you shouldn't be creating a new instance of Outlook every time you want to send an email, which is what's happening here.

For i = 2 To Lr

Set Outlook =CreateObject("Outlook.Application")
Set Email =Outlook.CreateItem(0)