Mailmerge from Excel using Word template VBA

Question

I have created a Userform where you can flag records as "In Progress", "Completed", and "Not Completed".

This will reflect on the sheet as below:

Records marked as "In Progress" will have the letter "P" in the status column. Records marked as "Completed" will have the letter "Y" in the status column. Records marked as "Not Completed" will have the letter "N" in the status column.

DataSheet http://im39.gulfup.com/VZVxr.png!

I want to run a mailmerge using the below buttons on the user form:

Userform http://im39.gulfup.com/98isU.png!

I have created this work template for the fields.

Document http://im39.gulfup.com/4WMLh.png!

This word template file called "MyTemplate" will be in the same directory as the excel file.

I am trying to figure out how: (1) Select recepients by filtering the "Status" column, so if the user pressed the first button, it will run the mail merge only for records with "P" in the status column.

(2) Run mailmerge without displaying Microsoft Word and only displaying the "Save As" dialog where the user can select where to save the file.

(3) This file should be saved in PDF format.

I am running Office 2013 and so far I have the code in bits and pieces and had no luck when trying to run it. I have uploaded the data I am trying to work on: MyBook: https://db.tt/0rLUZGC0 MyTemplate: https://db.tt/qPuoZ0D6

Any help will be highly appreciated. Thanks.

Could you please post your VBA code? I know you linked to the files themselves, but it is easier for many users to read the code along with the question rather than download a file and read it from there. — thunderblaster, Jan 17 '14 at 23:31
@thunderblaster Actually unfortunately I am so far not able to link both the files successfully, any tips? — CaptainABC, Jan 18 '14 at 19:23
The @ symbol isn't a tag on this site. It's not like Twitter. Those people are not getting any notifications. I would recommend editing your question and pasting the text of your code in it. Editing the question bumps it to the top again, so it should get more attention. The code will help users identify the problem. — thunderblaster, Jan 18 '14 at 21:36

donPablo · Accepted Answer · 2014-01-23T04:52:37.193

3

(1) What I use is the WHERE clause (on the OpenDataSource, you probably don't need all those options)

' setup the SQL
Dim sSQLModel As String, sSQLWhere As String
sSQLModel = " Where  ( AssignLtrType = 'T1' or AssignLtrType = 'T2'  ) ;"

' replace the appropriate value(s)
sSQLWhere = sSQLModel                   ' never replace in the model
sSQLWhere = Replace(sSQLWhere, "T1", mydatavariable)

' open the MERGE
doc.MailMerge.OpenDataSource Name:=sIn, _
    ConfirmConversions:=False, readOnly:=False, LinkToSource:=True, _
    AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
    WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
    Format:=wdOpenFormatAuto, Connection:= _
    "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
    "User ID=Admin;" & _
    "Data Source=" & sXLSPathFile & ";" & _
    "Mode=Read;Extended Properties=" & _
    "HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
    , SQLStatement:="SELECT * FROM `Detail$`", _
    SQLStatement1:=sSQLWhere, _
    SubType:=wdMergeSubTypeAccess

' do the MERGE
With doc.MailMerge
    .Destination = wdSendToPrinter
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
End With

(2) Prior to the above, make the doc Visible (or Invisible)

' setup the template document
Dim doc As Word.Document
Set doc = wrdApp.Documents.Add(sPathFileTemplate)
wrdApp.Visible = True   ' you can say False

(3) I have Adobe PDF as a Printer (the registry routines were from the web--Google them). Put this prior to OpenDataSource.

' Get current default printer.
SetDefaultPrinter "Adobe PDF"
'Create the Registry Key where Acrobat looks for a file name
CreateNewRegistryKey HKEY_CURRENT_USER, _
    "Software\Adobe\Acrobat Distiller\PrinterJobControl"

'Put the output filename where Acrobat could find it
SetRegistryValue HKEY_CURRENT_USER, _
    "Software\Adobe\Acrobat Distiller\PrinterJobControl", _
    wrdApp.Application.Path & "\WINWORD.EXE", sPathFilePDF

In the SQL, change the tab name from Detail$ to yourTab$ (needs trailing $)

added later--

Dim sIn As String
sIn = SelectAFile(sInitial:=sDriveSAO, sTitle:=" XLS file")
If (sIn = "" Or sIn = "False") Then Exit Sub

and Google for SelectAFile

added 1/22 aft

'   ============= added ===========
Dim xls As Excel.Application   ' for me, because I am running in MSAccess as mdb
Set xls = New Excel.Application
Dim wrdApp As Word.Application  ' for you, to have WORD running
Set wrdApp = New Word.Application
Dim sPathFileTemplate As String
sPathFileTemplate = xls.GetOpenFilename(" docx file,*.docx", , "Template file")
'   ============= added ===========

' changed    you only need one variable
sSQLModel = " Where  ( Status = 'T1'  ) ;"

' changed    replace, possibly with some screen value
sSQLWhere = Replace(sSQLWhere, "T1", "P")

' changed because your tab is named Sheet1
    , SQLStatement:="SELECT * FROM `Sheet1$`", _


'   ============= added ===========
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
'   ============= added ===========

edited Jan 23 '14 at 04:52

answered Jan 20 '14 at 06:59

donPablo

1,937
1
13
18

First, thank you very much for this great answer, but I'm getting a Compile Error: "Argument Not Optional" on the line `doc.MailMerge.OpenDataSource Name:=sIn, _` with `sIn` being highlighted. Is this where I have to input a path of the word template file? – CaptainABC Jan 20 '14 at 07:34
Dim sIn As String sIn = SelectAFile(sInitial:=sDriveSAO, sTitle:=" XLS file") If (sIn = "" Or sIn = "False") Then Exit Sub and Google for SelectAFile – donPablo Jan 21 '14 at 01:04
I have added this above in my answer. I believe sXLSPathFile is the same value. You seem to be making much headway. – donPablo Jan 21 '14 at 01:11
Thanks again for the response. I've tried adding the code u added (staring Dim sIn) to the beginning of my code, but I'm now getting a Compile Error: "Sub or Function not defined". So I did some googling and found this code for SelectAFile: `sIn = Application.GetOpenFilename("Excel file,*.xlsm", , "XLSM file")`. When I tried it, it opened a dialog where I selected my excel file but after I press open I get "Run-time error '424': Object required" with the whole 'open the Merge part highlighted yellow. Can u please try and see if the code is working for you, because sadly I had no luck so far :( – CaptainABC Jan 21 '14 at 22:38
Has your code already opened the WORD Template? i.e. item #2 above... so that "doc" is a valid object? Or perhaps SubType needs to be changed form Access to wdMergeSubTypeOther? If not, then I think that I need to see y/our code so far. Please paste it into a new answer box. – donPablo Jan 22 '14 at 07:58
I have edited my question to include the code I have so far. Any idea where the mistake is? – CaptainABC Jan 22 '14 at 12:34
I have edited my code to make your code work. Additions and changes are at the end of the code... You are on your own to make the PDF work. – donPablo Jan 22 '14 at 21:33
Thanks... I am a bit confused... which part is edited? Also, this is a screenshot of my full code and the error I am getting. [SCREENSHOT](http://im38.gulfup.com/6OfUW.png) – CaptainABC Jan 22 '14 at 22:18
I would really appreciate if you can explain a bit on which parts of the code load the Excel sheet and which parts loads the Word Template. Ideally I'm going for having VBA automatically select the file "MyTemplate.docx" in the same directory as the excel file, and the Excel file in which I have this code as the source file. I know I'm going somewhere wrong with opening the template and the source but not sure where... btw I have added the "Microsoft Word 15.0 Object Library" in VBA - References,, thinking it would help. – CaptainABC Jan 22 '14 at 22:23
Update: I have posted EDIT 2... any thoughts? – CaptainABC Jan 22 '14 at 23:01
Anytime that it goes into Debug mode and you RESET, it may leave a copy of WORD still running because the program did not go to the end and close the doc and quit the word app. CTL/ALT/DEL to start Task Mgr and look on Processes tab scroll down to any WORD still running, and exit those processes. – donPablo Jan 23 '14 at 04:46
Thanks! I got it to work and posted my final code as an answer. But I am still marking your answer as accepted for all the help. – CaptainABC Jan 24 '14 at 14:37

CaptainABC · Answer 2 · 2014-01-24T19:06:35.763

OK so with a lot of help from @donPablo I finally got a working code which does exactly what I want.

BTW the "Status" in sSQLModel = " Where ( Status = 'T1' ) ;" can be change to any other column heading, but in my case I am filtering based on a value in the column F (Status). The "P" in sSQLWhere = Replace(sSQLWhere, "T1", "P") can also be change to the value been filtered on, but in my case I want all the records containing "P" in the "Status" column.

The "Sheet1" in , SQLStatement:="SELECT * FROMSheet1$", _ can be changed to the name of the sheet containing the source data for the merge. (Don't forget to include the $ sign at the end of the sheet name.

Before proceeding make sure to load the Microsoft Word Object Library (VBA - Tools - References)

And here is the working code:

Private Sub CommandButton1_Click()

Dim xls As Excel.Application
Set xls = New Excel.Application
Dim wrdApp As Word.Application
Set wrdApp = New Word.Application
Dim sPathFileTemplate As String
sPathFileTemplate = ThisWorkbook.Path & "\MyTemplate.docx" 'This gets the file called MyTemplate from the same directory
                                                           'in which this excel file is running from

' setup the template document
Dim doc As Word.Document
Set doc = wrdApp.Documents.Add(sPathFileTemplate)
wrdApp.Visible = False   ' Make MS Word Invisible

Dim sIn As String
sIn = ThisWorkbook.FullName 'This Workbook is set the merge data source

' setup the SQL
Dim sSQLModel As String, sSQLWhere As String
sSQLModel = " Where  ( Status = 'T1'  ) ;"

' replace the appropriate value(s)
sSQLWhere = sSQLModel
sSQLWhere = Replace(sSQLWhere, "T1", "P")

' open the MERGE
doc.MailMerge.OpenDataSource Name:=sIn, _
    ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
    AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
    WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
    Format:=wdOpenFormatAuto, Connection:= _
    "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
    "User ID=Admin;" & _
    "Data Source=" & sXLSPathFile & ";" & _
    "Mode=Read;Extended Properties=" & _
    "HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
    , SQLStatement:="SELECT * FROM `Sheet1$`", _
    SQLStatement1:=sSQLWhere, _
    SubType:=wdMergeSubTypeAccess

' do the MERGE
With doc.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
End With


'If you want you can delete this part and proceed to diretly define the
'filename and path below in "OutputFileName"
On Error Resume Next
Dim FileSelected As String
FileSelected = Application.GetSaveAsFilename(InitialFileName:="Export", _
                                         FileFilter:="PDF Files (*.pdf), *.pdf", _
                                         Title:="Save PDF as")
If Not FileSelected <> "False" Then
MsgBox "You have cancelled"
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
Exit Sub
End If

If FileSelected <> "False" Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

wrdApp.Application.Options.SaveInterval = False

'Saves Documents as PDF and does not open after saving, you can change OpenAfterExport:=False to True
wrdApp.Application.ActiveDocument.ExportAsFixedFormat OutputFileName:=FileSelected, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, FROM:=1, To:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, _
KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing

MsgBox "Done"

End If  ' this EndIf pretains to the SaveAs code above

End Sub

I cannot stress enough how much help was @donPablo, thanks again, you just made my weekend and I am selecting your answer as accepted :)

I am very happy for your success, and glad to be of help. Thats what Stack is all about. You were a patient learner. My solution is driven by an outer loop that uses four different templates and two selection criteria, and does about 500 letters every two weeks. I tried to get the main points abstracted for your use. tkx. — donPablo, Jan 24 '14 at 18:45

Mailmerge from Excel using Word template VBA

2 Answers2

Linked