First off here is my code.
Sub RunMerge()
' Word constants
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdocSource = wd.Documents.Open(ThisWorkbook.Path & "\AAFCAAC-#4077508-v1-AAFC-FFPB-COPE-SATD-_AgriInnovation_Draft_Survey_Instructions_189318.doc")
strWorkbookName = ThisWorkbook.Path & "\" & "MD.xlsm"
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName, _
SQLStatement:="SELECT * FROM 'Mail Merge Data$'"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End Sub
I'm trying to get a mail merge going from excel to word. My problem (I believe) is with SQLStatement:="SELECT * FROM 'Mail Merge Data$'" for when I run my code excel goes into limbo waiting for word. When I go into my task manager I see word is stuck on selecting a table. There are no options in the table select menu and the designated workbook is only the path of my workbook with .xls appended to the end. If I remove the SQLStatement line the same thing happens but the select table is populated with the sheets and name ranges in my workbook. I'm hoping that this is a minor error or a typo on my part.
I think the problem is that you removed additional quotation marks which are required in your situation. Your SQL statement should rather looks like:
SQLStatement:="SELECT * FROM `'Mail Merge Data$'`"
You could also try with this code:
SQLStatement:="SELECT * FROM [Mail Merge Data$]"
Related
I want to execute a mail merge from Excel through VBA.
I'm having some difficulties unprotecting and protecting the Word document. How do I unprotect the Word document, execute the mail merge and then protect the document once again?
Sub RunMerge()
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
Validate_Form
If Left(Sheet1.Range("B48").Text, 7) = "Missing" Then
Exit Sub
Else
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
Set wdocSource = wd.Documents.Open("C:\Users\owen4512\Desktop\Templates\Document1.docx")
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.Unprotect
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Admin$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = 11 'wdDefaultFirstRecord
.LastRecord = 11 'wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Protect , Password:=""
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End If
End Sub
I am assuming that your code already is unprotecting the primary merge document and performing the merge. If so, the primary merge document should still be protected after your macro runs. Closing it without saving changes should accomplish that, since unprotecting it is a change.
After some searching online i found the issue was being caused by word opening in "Reading mode" and not in print view. I've added 'wd.ActiveWindow.View = wdPrintView' which has resolved my issue. Thanks everyone for your help on this :)
Here is the scenario. I am using VBA in Excel 2016 to initiate a mail merge with Word. The data source for the merge is a spreadsheet in the current Excel document. The routine generates a separate merge document for each iteration of a dataset.
As I loop through the datasets, a new merge doc is created and saved as a PDF document.
Issue #1:
The routine as it loops creates the separate merge docs. Each merge doc is visible, so if I loop through 5 datasets, I get 5 open merge docs, each with the appropriate dataset values. But when saving as PDF, it saves the first merge doc over and over again.
In my code, the "Save As PDF" section generates a unique filename based on a field from the dataset and that works. Each saved PDF has the appropriate filename, but the actual file is the first merge doc over and over again.
How can I get the routine to save the first merge doc as PDF and then move on to the next iteration?
Issue #2:
As the routine loops and creates the independent merge docs, how can I then close the newly created word merge docs?
Existing code:
z = 0
For z = 0 To xCount - 1
lb2_selected = "''" + lb2_array(0, z) + "''"
addr_query = "sp_address_filter '" + lb2_selected + "','" + lb1_selected + "','','" + lb3_selected + "','',''"
'MsgBox (addr_query)
Set rs = conn.Execute(addr_query)
'Clear any existing data from Sheet2
Worksheets("Sheet2").Range("A1:Z10000").Clear
'Load new iteration of data into Sheet2
With rs
For h = 1 To .Fields.Count
Sheet2.Cells(1, h) = .Fields(h - 1).Name
Sheet2.Cells(1, h).Font.Bold = True
Next h
End With
If Not rs.EOF Then
Sheets(2).Range("A2").CopyFromRecordset rs
End If
rs.Close
'Set value for filename
lb2_array_value = lb2_array(1, z)
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
Set wd = CreateObject("Word.Application")
Set wdocSource = wd.Documents.Open("c:\users\john\documents\LabelPage3.docx")
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet2$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"C:\users\john\documents\labels\" + lb2_array_value + ".pdf", _
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
wd.Visible = True
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
Next z
Several issues emerge with your current setup. Consider the following adjustments:
MS WORD OBJECT: ActiveDocument is part of the MS Word object library and not Excel. By not qualifying it with a Word.Application object, you are assuming it for Excel. Therefore, qualify it accordingly: wd.ActiveDocument. On my end, doing this hangs Excel infinitely without error.
EARLY BINDING Since none of your Word constants are declared, you seem to have a VBA reference to MS Word Object Library checked off. Therefore, do not mix late-binded with early binding calls:
Change the following:
Dim wd As Object
Dim wdocSource As Object
...
Set wd = CreateObject("Word.Application")
To the below:
Dim wd As Word.Application
Dim wdocSource As Word.Document
...
Set wd = New Word.Application
LOOP PROCESS: Place your Word object assignment outside of the loop as only the documents need to be set and unset inside the loop. And use the Application.Quit method to effectively close out the object.
Dim wd As Word.Application
Dim wdocSource As Word.Document
...
Set wd = New Word.Application
wd.Visible = True
For z = 0 To xCount - 1
... ' SHEET QUERY PROCESS
Set wdocSource = wd.Documents.Open("c:\users\john\documents\LabelPage3.docx")
... ' MAIL MERGE PROCESS
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Next z
wd.Quit False
Set wd = Nothing
WITH BLOCK: For easy readability, consistently use the With...End With block for MailMerge process:
With wdocSource.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet2$`"
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
ERROR HANDLING: As best practice, wrap entire process in error handling especially to destroy objects as code resulting in runtime error will leave object running as a background process.
Public Sub RunMailMerge()
On Error GoTo ErrHandle
...
ExitHandle:
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
wd.Quit False
Set wd = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub
please could someone help me? I use mail merge and Word document as a template for labels. After execution of mail merge I need to show word print dialog for printer selection and to be able set label details in printer properties. I tried to set destination of mail merge to wdSendToPrinter , call dialog various ways e.g. wd.Dialogs(wdDialogFilePrint).Display but nothing works. Do you have any other suggestion, please?
Private Sub CommandButton1_Click()
Dim wdDoc, wd As Object
Dim template, excel As String, merge As String
template = ThisWorkbook.Path & "\template\templateA4.docx"
excel = ThisWorkbook.Path & "\" & ThisWorkbook.Name
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wd.documents.Open(template)
wdDoc.Application.Visible = False
wdDoc.MailMerge.OpenDataSource _
Name:=excel, _
AddToRecentFiles:=False, _
Revert:=False, _
Connection:="Data Source=" & excel & ";Mode=Read", _
SQLStatement:="SELECT * FROM `List1$`"
With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = 1
.LastRecord = 5
End With
.Execute Pause:=False
End With
merge = wdDoc.Application.activedocument.Name
wdDoc.Application.documents(template).Close wdDoNotSaveChanges
wdDoc.Application.Visible = True
wd.Application.documents(merge).Activate
'need to show word print dialog at this point
wdDoc.Application.ActiveDocument.PrintOut Background:=False
wdDoc.Application.ActiveDocument.Close wdDoNotSaveChanges
wdDoc.Close SaveChanges:=False
Set wdDoc = Nothing
wd.Application.Quit wdDoNotSaveChanges
Set wd = Nothing
End Sub
Try using wd.Dialogs(88).Show instead of wd.Dialogs(wdDialogFilePrint).Display
I am trying to create a simple .vbs file that I can run using task scheduler automatically at a set time that will open a word doc and perform email mail merge to every recipients.
Word doc is already setup with pre-defined fields and data source "re-connection" is included to ensure that source data is setup properly.
I'm having problem running below code, which in turn will open 2 word applications (the master files which contain all records and new 2 pages word file with only first and last record).
Please help me debug this code, as I am starting to lose my sanity in getting this fixed.
Dim wd As Object
Dim WDoc As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = CreateObject("Word.Application")
wd.Application.Visible = True
Set WDoc = wd.Documents.Open("C:\Users\Documents\test\test.docx")
strWorkbookName = "C:\Users\Documents\test\test_datasource.xlsx"
WDoc.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=0, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Summary$`"
With WDoc.MailMerge
.Destination = wdSendToEmail
.MailAddressFieldName = "Email"
.MailSubject = "TEST - EMAIL SUBJECT"
.SuppressBlankLines = True
.MailAsAttachment = False
.MailFormat = wdMailFormatHTML
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute
End With
Set wd = Nothing
Set WDoc = Nothing
End Sub
Probably this might suffice:
sub M_snb()
with getobject("C:\Users\Documents\test\test.docx")
with .mailmerge
.Destination = 2
.MailAddressFieldName = "Email"
.MailSubject = "TEST - EMAIL SUBJECT"
.SuppressBlankLines = True
.MailAsAttachment = False
.MailFormat = 1
.execute
end with
.close 0
end with
End sub
NB. in late binding the Word constants won't be recognised.
I have an excel sheet with data and want to export it to a new word document.
Is it possible to start MAIL MERGE from excel macro by clicking a button on the sheet?
If your Word document is already configured with the merge fields, and you are running the macro from the workbook that contains the data you want to merge into the Word document, then try this:
Sub RunMerge()
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdocSource = wd.Documents.Open("c:\test\WordMerge.docx")
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet1$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End Sub
To get dendarii's solution to work I had to declare Word constants in Excel VBA as follows:
' Word constants
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16
If your word document is already configured with data source and merge fields layout then it becomes much simpler. In the example below MailMergeLayout.doc is all setup ready to perform a merge. A button in Excel is linked to RunMailMerge() as below. All the code is contained in an Excel VBA module.
Sub RunMailMerge()
Dim wdOutputName, wdInputName As String
wdOutputName = ThisWorkbook.Path & "\Reminder Letters " & Format(Date, "d mmm yyyy")
wdInputName = ThisWorkbook.Path & "\MailMergeLayout.doc"
' open the mail merge layout file
Dim wdDoc As Object
Set wdDoc = GetObject(wdInputName, "Word.document")
wdDoc.Application.Visible = True
With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.Execute Pause:=False
End With
' show and save output file
wdDoc.Application.Visible = True
wdDoc.Application.ActiveDocument.SaveAs wdOutputName
' cleanup
wdDoc.Close SaveChanges:=False
Set wdDoc = Nothing
End Sub
Private Sub CommandButton1_Click()
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "C:\Documents and Settings\User\Desktop\mergeletter.doc"
wordapp.Visible = True
wrddoc = wordapp.documents("C:\Users\User\Desktop\sourceofletters.xls")
wrddoc.mailmerge.maindocumenttype = wdformletters
With wrddoc.activedocument.mailmerge
.OpenDataSource Name:="C:\Users\User\Desktop\sourceofletters.xls", _
SQLStatement:="SELECT * FROM `Sheet1`"
End With
End Sub
Above code is to open a word mailmerge document (with its source link and mergefield codes all setup ) all I want is for the message box "Opening the document will run the following SQL command " to be made available to the user , from that point forward the user could either select 'Yes' or 'No'.
Dim opt As String
opt = MessageBox("Opening the document will run the following SQL command", vbYesNo)
If opt = vbYes Then
'execute query
End If