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
– thunderblaster, Commented Jan 17, 2014 at 23:31
@thunderblaster Actually unfortunately I am so far not able to link both the files successfully, any tips? — CaptainABC
– CaptainABC, Commented Jan 18, 2014 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
– thunderblaster, Commented Jan 18, 2014 at 21:36

donPablo · Accepted Answer · 2014-01-23 04:52:37Z

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, 2014 at 4:52

answered Jan 20, 2014 at 6:59

donPablo

1,9691 gold badge13 silver badges20 bronze badges

Sign up to request clarification or add additional context in comments.

12 Comments

CaptainABC Over a year ago

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?

donPablo Over a year ago

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

donPablo Over a year ago

I have added this above in my answer. I believe sXLSPathFile is the same value. You seem to be making much headway.

CaptainABC Over a year ago

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 :(

donPablo Over a year ago

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.

|

CaptainABC · Accepted Answer · 2014-01-24 19:06:35Z

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.

Collectives™ on Stack Overflow

Mailmerge from Excel using Word template VBA

2 Answers 2

12 Comments

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

12 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related