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
Related
The below code is from a mail merge VBA and file is stored on my One Drive, and the work the StrWorkbookName is a URL (per the below), however, the code cannot find the file, however, if I put the C:Users/ path address rather than the URL, it works for me but not other users (as they do not have direct access). Anyone know of a fix? Thank you.
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("https://carnivalcorp-my.sharepoint.com/:w:/r/personal/carl_stephens_seabourn_co_uk/Documents/Joiners_Docs/HR_Email_One_Docs/Visa%20Mail%20Merge.docx")
**strWorkbookName = "https://carnivalcorp-my.sharepoint.com/:x:/r/personal/carl_stephens_seabourn_co_uk/Documents/Joiners_Docs/Tracker%20-%20New.xlsm"**
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `V$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = 1
.LastRecord = 1
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End Sub
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 :)
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.
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$]"
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