Change Word mailmerge source with VBA?

[Gasman]

Hi all,
In this project I wish to be able to create a mailmerge to an A4 label format, however I am trying to make it easier for the controller to print the data.


The source workbook is going to have a sheet for each letter of the alphabet. Columns would be the same on each sheet.
I want to be able to ask the controller(user) which sheet he wishes to load to the document, just using a simple InputBox.


I was considering taking each sheet's data and creating an All sheet, referring to that in the word document and then get him to filter by using another column with the first character of the surname, but I think this would be easier for him, as he is not that computer literate. He would not be printing regularly, just initially and then after a few changes to that particular alpha set.


So I was thinking of an input box to ask what letter and then use that to change the mailmerge source of the word document, rather than him having to direct word to a new sheet each time?
Then all he has to do is Print.


Would anyone be able to direct me to some code that I could modify to do the above please?


TIA

[Gasman]

I have managed to cobble together this much from various searches.
Most of this from https://stackoverflow.com/questions/62006117/how-to-opendatasource-for-word-mailmerge-from-excel-worksheet
However I am not using a DB, just want to use an Excel worksheet.


Option Explicit
Sub Contract(Wordfile As String, strSheetName As String)
Dim wdApp As Object, wdDoc As Object
Dim StrMMSrc As String, strSQL As String


StrMMSrc = "F:\Temp\Address Trial,xlsm" 'ActiveWorkbook.FullName
Wordfile = "F:\Users\Paul\Documents\Address Details 7165 MM.docm"
strSheetName = "Sheet1"
strSQL = "SELECT * FROM " & strSheetName & ""


If Dir(Wordfile) = "" Then
MsgBox "Cannot find:" & vbCr & Wordfile, vbExclamation
Exit Sub
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo Err_Handler


With wdApp
.Visible = True
.WordBasic.DisableAutoMacros
.DisplayAlerts = 0 ' wdAlertsNone
Set wdDoc = .Documents.Open(Wordfile)
With wdDoc
With .MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:=strSQL, SubType:=wdMergeSubTypeAccess
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
.Close SaveChanges:=False
End With
End With


Err_Handler:
Debug.Print Err.Number & " - " & Err.Description
MsgBox Err.Number & " - " & Err.Description

Set wdDoc = Nothing
Set wdApp = Nothing

End Sub


but get the attached screen when trying to set the source?

[macropod]

If you're running this from Excel, the document you're using shouldn't be saved as a mailmerge main document. Rather, you should be connecting to the required data source as & when required. Regardless, the following code copes with a document that may or may not have been saved as a mailmerge main document:

Sub RunMerge()
' Sourced from: http://www.vbaexpress.com/forum/showthread.php?70461-Change-Word-mailmerge-source-with-VBA
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String
StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrName = InputBox("Please input the name of the source worksheet")
If Trim(StrName) = "" Then Exit Sub
Dim wdApp As New Word.Application, wdDoc As Word.Document
wdApp.Visible = True
wdApp.WordBasic.DisableAutoMacros
wdApp.DisplayAlerts = wdAlertsNone
StrMMDoc = StrMMPath & "MailMergeMainDocument.doc"
Set wdDoc = wdApp.Documents.Open(FileName:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
With .MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `" & StrName & "$`"
.Execute Pause:=False
.MainDocumentType = wdNotAMergeDocument
End With
.Close SaveChanges:=False
End With
With wdApp.ActiveDocument .SaveAs Filename:=StrMMPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
wdApp.DisplayAlerts = wdAlertsAll
Set wdDoc = Nothing: Set wdApp = Nothing
Application.ScreenUpdating = False
End Sub

[Gasman]

Hi macropod,

I amended the code for my situation at present as below, but I still get that table request and the incorrect path?



Sub RunMerge()
' Sourced from: http://www.vbaexpress.com/forum/showthread.php?70461-Change-Word-mailmerge-source-with-VBA
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String


StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrMMDoc = "F:\Users\Paul\Documents\Address Details 7165 MM.docx"
StrName = InputBox("Please input the name of the source worksheet")


If Trim(StrName) = "" Then Exit Sub
Dim wdApp As New Word.Application, wdDoc As Word.Document


wdApp.Visible = True
wdApp.DisplayAlerts = wdAlertsNone
'StrMMDoc = StrMMPath & StrMMDoc '"MailMergeMainDocument.doc"


Set wdDoc = wdApp.Documents.Open(Filename:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
With .MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM '" & StrName & "'"
.Execute Pause:=False
.MainDocumentType = wdNotAMergeDocument
End With
.Close SaveChanges:=False
End With


wdApp.DisplayAlerts = wdAlertsAll
Set wdDoc = Nothing
Set wdApp = Nothing
Application.ScreenUpdating = True


End Sub


Also tried in the same folder as the Excel workbook as you had it


'StrMMDoc = "F:\Users\Paul\Documents\Address Details 7165 MM.docx"
StrName = InputBox("Please input the name of the source worksheet")


If Trim(StrName) = "" Then Exit Sub
Dim wdApp As New Word.Application, wdDoc As Word.Document


wdApp.Visible = True
wdApp.DisplayAlerts = wdAlertsNone
StrMMDoc = StrMMPath & "Address Details 7165 MM.docx"


but same error?

[macropod]

I've revised the code slightly. Try it now.

Also, if you prefer, you could replace the Inputbox with ActiveSheet.Name, so that the mailmerge automatically connects to whatever the active sheet is.

[Gasman]

Hi Paul,

Another Paul here.
Yes, this is just in the initial stages. I prefer to get the basics working before trying to enhnace it.

WHilst waiting for a reply I created some code to copy all alpha sheets a-z to an All sheet, that way it is the same sheet each time, just have to filter, but actual sheet is a very good option.

Will try it out and report back.
Are you able to explain where the 'F:\Temp.xls' comes from as that is not the name of the workbook, that I checked. :-(

[macropod]

Are you able to explain where the 'F:\Temp.xls' comes from as that is not the name of the workbook, that I checked. :-(
I can't see any reference to F:\Temp.xls in the previous discussion.
In your code, you have:

SQLStatement:="SELECT * FROM '" & StrName & "'"
whereas I posted:

SQLStatement:="SELECT * FROM `" & StrName & "$`"
The ` characters are not Apostrophe characters (a.k.a. plain quotes - i.e. '); they're Grave Accent characters (ASCII 96) - which VBA and, more importantly, the SQL statement recognise.

[Gasman]

In your code, you have:

SQLStatement:="SELECT * FROM '" & StrName & "'"
whereas I posted:

SQLStatement:="SELECT * FROM `" & StrName & "$`"
The ` characters are not Apostrophe characters (a.k.a. plain quotes - i.e. '); they're Grave Accent characters (ASCII 96) - which VBA and, more importantly, the SQL statement recognise.
Hmm, will have to investigate further, as I have copied code before from various sites and the VBE compiler always complained about (what I thought were) those quotes, and I replaced them with the sing quote character and then the code compiled.

How does one enter those characters?, does it have to be by ascii code number?

Very strange side effect when they are used in this situation.

[macropod]

Hmm, will have to investigate further, as I have copied code before from various sites and the VBE compiler always complained about (what I thought were) those quotes, and I replaced them with the sing quote character and then the code compiled.
I have no difficulty at all copying & pasting such code into the VBE. There is certainly no compiler complaint about them (or about Apostrophe characters if I'd used them - but they wouldn't work for the SQL).

How does one enter those characters?, does it have to be by ascii code number?
You can copy/oaste them from here, or input them via Alt 096 from the keyboard.

Very strange side effect when they are used in this situation.
I have no idea what you mean by that. In my experience they work as intended. Perhaps you're just unfamiliar with mailmerge SQL.

[Gasman]

I have no difficulty at all copying & pasting such code into the VBE. There is certainly no compiler complaint about them (or about Apostrophe characters if I'd used them - but they wouldn't work for the SQL).

You can copy/oaste them from here, or input them via Alt 096 from the keyboard.

I have no idea what you mean by that. In my experience they work as intended. Perhaps you're just unfamiliar with mailmerge SQL.
No, I mean when I substituted them for the single quote, I got that table screen and F:\Temp.xls as the source?

All is working as I would like it to now. Just have to save as pdf, and then the controller just needs to issue around 20 clicks to get the output he needs, and the odd one now and again when it gets updated.

Thanks again.

[macropod]

I mean when I substituted them for the single quote, I got that table screen and F:\Temp.xls as the source?
That happened because the SQL couldn't find the datasource specified by your:

StrMMSrc = "F:\Temp\Address Trial,xlsm"
Note your use of a comma instead of a period before 'xlsm' in post #2...

Just have to save as pdf
Code for saving added to post #3.

[Gasman]

That happened because the SQL couldn't find the datasource specified by your:

StrMMSrc = "F:\Temp\Address Trial,xlsm"
Note your use of a comma instead of a period before 'xlsm' in post #2....

Yes, I spotted that a while back and just use the current workbook name as you did. In fact I mentioned that error in another forum.
However, humour me and please try it for yourself, as even with the current code, I get the table prompt with the incorrect workbook name. :( I just tried it again, but if I am still making some silly mistake, I would love to know what it is.


Code for saving added to post #3.

Sorry, missed that completely. :(

Current code.


Sub RunMerge()
' Sourced from: http://www.vbaexpress.com/forum/showthread.php?70461-Change-Word-mailmerge-source-with-VBA
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String, strPDFName As String
Dim iLastRow As Integer


StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrMMDoc = "F:\Users\Paul\Documents\Test Address Details 7165 MM.docx"
StrName = ActiveSheet.Name 'InputBox("Please input the name of the source worksheet")


If Trim(StrName) = "" Then Exit Sub
'Trim Filter column else we get extra records with no values
iLastRow = GetLastRow(StrName, "A") + 1
ActiveSheet.Range("A" & iLastRow & ":J1000").Delete


Dim wdApp As New Word.Application, wdDoc As Word.Document
wdApp.Visible = True
wdApp.WordBasic.DisableAutoMacros
wdApp.DisplayAlerts = wdAlertsNone
'StrMMDoc = StrMMPath & "MailMergeMainDocument.doc"
Set wdDoc = wdApp.Documents.Open(Filename:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
With .MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `" & StrName & "$`"
.Execute Pause:=False
.MainDocumentType = wdNotAMergeDocument
End With
' .Close SaveChanges:=False
'Save as PDF file
strPDFName = "GCCS Passengers - " & StrName
With wdApp.ActiveDocument
.SaveAs Filename:=StrMMPath & strPDFName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
'.Close SaveChanges:=False
End With


'wdApp.Documents("Labels1").ExportAsFixedFormat OutputFileName:= _
' StrMMPath & strPDFName & ".pdf", _
' ExportFormat:=wdExportFormatPDF, _
' OpenAfterExport:=True, _
' OptimizeFor:=wdExportOptimizeForPrint, _
' Range:=wdExportAllDocument, _
' IncludeDocProps:=True, _
' CreateBookmarks:=wdExportCreateWordBookmarks, _
' BitmapMissingFonts:=True


End With


wdApp.DisplayAlerts = wdAlertsAll
MsgBox "Mailmerge document created. Switching to Word application, document Labels1"
wdApp.Activate


Set wdDoc = Nothing
Set wdApp = Nothing
Application.ScreenUpdating = True


End Sub

[macropod]

Humour me and please try it for yourself, as even with the current code, I get the table prompt with the incorrect workbook name. :( I just tried it again, but if I am still making some silly mistake, I would love to know what it is.
If you mis-type the worksheet name, for example, you'll get the prompt.

[Gasman]

If you replace your Alt + 96 with a single quotes in that Select clause, you get what window I was describing. That was caused by my error, replacing that character, thinking that the Alt + 96 character was one of those that VBA does not like.

[macropod]

If you replace your Alt + 96 with a single quotes in that Select clause, you get what window I was describing. That was caused by my error, replacing that character, thinking that the Alt + 96 character was one of those that VBA does not like.
That has nothing to do with VBA 'liking' the character but everything to do with whether you end up with a valid SQL query. In database apps and Word field coding via the DATABASE field, such queries can be input via the keyboard and it's essential to get the syntax right.

[Gasman]

@macropod
May I ask one more question please.?
I arranged a sort of the data in Excel, by Surname then Address 1. So each sheet is sorted before being merged.

Whilst the data 'almost' came into the mailmerge in that order, it was not quite. :(

I found that if I put the sort order in the document, then I got exactly what the sheet had, as that was previously sorted in the same order. That is fine for this application as we only need two, perhaps three, and that appears to be the limit for the document. What if I needed more though?

I know in Access, that a report takes no notice of the order of the incoming data. Is this the same with mailmerge?, or have I missed something simple?
The mailmerge was almost to the order, but a few records were printed in a different order to that in the sheet.

I even kept the ScreenUpdating as True, in case that was causing it, but appeared to make no difference?

Could I perhaps put the sort order into the Select clause if more than three.?

TIA

[macropod]

A mailmerge will output the source data in whatever order they appear in the dtatasource unless the SQL tells it to do otherwise. In this case, there is nothing in the SQL about the output order, so it just takes it in the order in which it appears.

Accordingly, I find it strange that you should say some records were output in an order different from that in which they occur in the datasource (worksheet).

That said, to control the sort order via the mailmerge itself, you could change:

SQLStatement:="SELECT * FROM `" & StrName & "$`"
to, for example:

SQLStatement:="SELECT * FROM `" & StrName & "$` ORDER BY `LAST NAME` ASC,`ADDRESS` ASC,`FIRST NAME` ASC"
with this change, the records should be output in ascending surname order, with all residents at a given address grouped together. Naturally, you'll need to change the field names used for the sorting to whatever yours are called.

[Gasman]

Hi macropod,
Thanks for the reply.
That is what I could not understand. I took pains to make sure the data was sorted before opening the MM doc, yet the results were just slightly different, that I almost missed it.

One example was the first record was record 3, then 4, then 1 and 2.

Not to worry, I know now how to overcome it, but I was just thinking I had missed something simple? :(

Thank you for confirming the syntax for sort fields.

Have a great Xmas and New Year.