I'm using mail merge function to merge data from excel sheets to word letter. and I use the following connection and command.
Sub WriteInWord()
Dim WdApp As Object
Dim WdDoc As Object
result = Path.GetFileName(TextBox1.Text)
Dim BatchNumber = Mid(result, 18, 5)
WdApp = CreateObject("Word.Application")
WdDoc = CreateObject("Word.Document")
WdDoc = WdApp.Documents.Open(TextBox2.Text, ConfirmConversions:=
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="",
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="",
WritePasswordTemplate:="", XMLTransform:="")
WdDoc.MailMerge.OpenDataSource(Name:=TextBox1.Text,
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True,
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="",
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, Connection:=
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin; Mode=Read; Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database=""""; Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0; Jet OLEDB:Global", SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="")
' .Destination 0 = DOCUMENT, 1 = PRINTER
WdApp.ActiveDocument.MailMerge.Destination = 0 'wdSendToNewDocument
WdApp.ActiveDocument.MailMerge.SuppressBlankLines = True
With WdApp.ActiveDocument.MailMerge.DataSource
.FirstRecord = 1 'wdDefaultFirstRecord
.LastRecord = -16 'wdDefaultLastRecord
End With
WdApp.ActiveDocument.MailMerge.Execute(Pause:=False)
WdDoc.Close(savechanges:=False) 'Close the original mail-merge template file.
Dim outputFilename As String = Path.ChangeExtension(inputFilePath + "\" + BatchNumber + ".docx", "pdf")
Dim fileFormat As Object = WdSaveFormat.wdFormatPDF
WdApp.ActiveDocument.SaveAs(outputFilename, fileFormat)
WdApp.Quit()
WdDoc = Nothing
WdApp = Nothing
MsgBox("FINISHED WITH MERGE")
End Sub
the excel value is this
Merged value from excel to word is this
As you can see, the value from excel to word has changed. How can I fix this? Thank you.
Thanks for the inspiration.
I know where's my problem. I changed the SQL statement from
SQLStatement:="SELECT * FROM `Sheet1$`"
To
SQLStatement:="SELECT * FROM `SheetName$`"
The "SheetName" is excel sheet name, because my spreadsheet has a name.
Related
I'm Very New to Macro and VB. I recorded one macro in Word, below is some portion of the code.
ActiveDocument.MailMerge.OpenDataSource Name:= _
"Choosen/Folder/Path/file.xlsx", ConfirmConversions:= _
False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"User ID=Admin;Data Source=Choosen/Folder/Path/file.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database L" _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
How can I allow user to choose DataSource every time?
I tried the following:
Public Function ChooseFolder()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = Replace(.SelectedItems(1), "\", "\\")
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Sub .....
..
Dim fldr As String
fldr = ChooseFolder()
ActiveDocument.MailMerge.OpenDataSource Name:= _
fldr, ConfirmConversions:= _
....
End Sub
But have the following error:
There's a Word dialog box specifically for opening a mailmerge data source.
e.g. at its simplest,
Sub openmmds1()
Dialogs(WdWordDialog.wdDialogMailMergeOpenDataSource).Show
End Sub
although some people say the "correct" way to use these dialogs is as follows:
Sub openmmds2()
Dim dlg As Word.Dialog
Set dlg = Dialogs(WdWordDialog.wdDialogMailMergeOpenDataSource)
dlg.Show
Set dlg = Nothing
End Sub
and you may find that closing any existing data source first avoids some problems. In modern versions of Word on both Windows and Mac you should be able to do that this way:
ActiveDocument.MailMerge.DataSource.Close
but in older versions there is no .Close method and you have to remove all the MailMerge info using, e.g.
ActiveDocument.MailMerge.MainDocumentType = WdMailMergeMainDocType.wdNotAMergeDocument
I have a Word document with a Macro that is executed daily and converts all Word documents that had been updated within the last 24 hours to PDF. The problem is that it runs on the File Server, that the folder contains about 150'000 files and that the macro takes 7 minutes while occupying more than 45% of the CPU. Usually there won’t be more than 30-40 files that need that conversion to PDF. But off course the macro scans all the content
I noticed that the PDF’s are all created within the first minute so my guess is that “by nature” windows starts in its routines with the most recent files and proceeds towards the oldest.
Using this characteristics, I could probably run this loop 100 times and abort it then.
Any comment is apeciated.
This is the macro:
Sub Loop_through_files()
Dim cDocuments As New Collection
Dim sPath As String, sFilter As String
Dim sCurrentDocName As String, sFullname As String
Dim i As Long
Dim xNewName As String
Dim xIndex As Integer
Set WordObject = CreateObject("Scripting.FileSystemObject")
sPath = "\\XXXXXXXX\XXXXX\Certificates"
sFilter = "*.DOC*"
Set cDocuments = Nothing
sCurrentDocName = Dir(sPath & "\" & sFilter)
Do Until sCurrentDocName = ""
cDocuments.Add Item:=sCurrentDocName
sCurrentDocName = Dir
Loop
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = cDocuments.Count To 1 Step -1 '
sFullname = sPath & "\" & cDocuments(i)
Set f = WordObject.GetFile(sFullname)
If f.DateLastModified > DateAdd("d", -1, Date) Then
xIndex = InStr(cDocuments(i), ".")
xNewName = Left(cDocuments(i), xIndex) + "pdf"
Documents.Open FileName:=sFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=sPath & "\" & xNewName, _
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
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges, OriginalFormat:=wdOriginalDocumentFormat
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I have a macro that converts (exports) word documents inside a folder into PDF. The macro works, but WORD keeps on popping up the save dialog, which kills the idea of a batch operation. The command
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
that helped me on other ocasions, does not work for some reason. Any suggestion is welcomed.
Martin
Sub Loop_through_files()
Dim cDocuments As New Collection
Dim sPath As String, sFilter As String
Dim sCurrentDocName As String, sFullname As String
Dim i As Long
Dim xNewName As String
Dim xIndex As Integer
sPath = "C:\Users\xxxxxx\Desktop\ConvertPDF"
sFilter = "*.DOC*"
Set cDocuments = Nothing
sCurrentDocName = Dir(sPath & "\" & sFilter)
Do Until sCurrentDocName = ""
cDocuments.Add Item:=sCurrentDocName
sCurrentDocName = Dir
Loop
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = cDocuments.Count To 1 Step -1 '
sFullname = sPath & "\" & cDocuments(i)
xIndex = InStr(cDocuments(i), ".")
xNewName = Left(cDocuments(i), xIndex) + "pdf"
Documents.Open FileName:=sFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=sPath & "\" & xNewName, _
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
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
ActiveWindow.Close
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
In the Close method calls you need to specify the OriginalFormat parameter which is represented by the WdOriginalFormat enumeration:
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges, OriginalFormat:=wdOriginalDocumentFormat
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.
(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 ===========
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 have the following code to perform a mail merge using VBA, after the mail merge is performed the word document opens minimized, is there a way to have the document opened as normal(maximized)?
Dim DocName As String
Echo -1, "Merge in progress..."
Dim templateName As String, tempRoot As String
tempRoot = "c:\temp\mailmerge"
templateName = tempRoot & "CertificateRSZDutch.dotx"
Dim objDoc As Word.Document
Dim objWord As New Word.Application
Set objDoc = objWord.Documents.Open(templateName)
objWord.Visible = True
DoCmd.TransferText acExportDelim, , "Mailmerge_CertificateRSZDutch", "Q:\jas\hr\mailmerge\LES\CertificateRSZDutch.txt", True
objDoc.MailMerge.OpenDataSource Name:= _
tempRoot & "CertificateRSZDutch.txt", ConfirmConversions:=False, ReadOnly _
:=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:= _
"", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="", SQLStatement:="", SQLStatement1:="", SubType:= _
wdMergeSubTypeOther
objDoc.MailMerge.Execute
objDoc.Close False
objWord.ActiveDocument.SaveAs tempRoot & "CertificateRSZ.docx"
Set objDoc = objWord.Documents.Open(Filename:=tempRoot & "CertificateRSZ.docx")
Set objWord = Nothing
Set objDoc = Nothing
Thanks
Put the following code in your program before opening the word document
Dim shell As New shell
shell.MinimizeAll
this will minimize all the opened applications windows
and put this code after opening the word document.
objWord.Application.WindowState = wdWindowStateMaximize
this will maximize the word document to be opened.