'encapsulates getting the word application, using GetObject first, and Create obect
Public Function fGetApp(Optional bCreated As Boolean) As Object
Dim oRet As Object
'attempt to get it, ignoring any error if it isn't launched
On Error Resume Next
Set oRet = GetObject(, "Word.Application")
'if we didn't get it, then attempt to create it, but reset error trapping
On Error GoTo 0
If oRet Is Nothing Then
Set oRet = CreateObject("Word.Application")
bCreated = True
End If
Set fGetApp = oRet
End Function
Sub MailMerge()
Dim appWord As Word.Application
Dim oMailMergeDoc As Word.Document
MSG1 = MsgBox("Do you want to continue with the mail merge?", vbYesNo, "Confirm")
If MSG1 = vbYes Then
ElseIf MSG1 = vbNo Then
Exit Sub
End If
'Ensures workbook saved
ThisWorkbook.Save
'Create new quotation for template
Set appWord = fGetApp
Set oMailMergeDoc = appWord.Documents.Add("Q:\AirMaster\AirMaster Quotation.dotm")
appWord.Visible = True
With appWord
.Visible = True
.ActiveDocument.SaveAs2 Filename:="Prod Quote_xxAMxHRV_ProjName " & Format(Date, "ddmmyyyy") & ".docx"
End With
MailMergeToExcel oMailMergeDoc
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub
Sub MailMergeToExcel(oDoc As Word.Document)
Dim sConnection As String
Dim strSourcePath As String
strSourcePath = oMailMergeDoc
If strSourcePath = "" Then
Exit Sub
End If
'your connection string, also more easily separated with line breaks and arguments
sConnection = "Provider=Microsoft.ACE.OLEDB.14.0;" & _
"User ID=Admin;" & _
"Data Source=" & strSourcePath & ";" & _
"Mode=Read;" & _
"Extended Properties=""HDR=YES;IMEX=1;"";" & _
"Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";" & _
"Jet OLEDB:Engine Type=35;" & _
"Jet OLEDB:"
'using your conection string... with the parameter names and the passed values separated nicely
oMailMergeDoc.MailMerge.OpenDataSource _
Name:=strSourcePath, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
SQLStatement:="SELECT * FROM `MailMerge`", _
Connection:=sConnection, _
SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:=""
End Sub