chipsworld
Board Regular
- Joined
- May 23, 2019
- Messages
- 164
- Office Version
- 365
All,
I am confident that someone has a solution to the below...
I have a mail merge that works perfectly except...
It will run each row regardless of content in trigger cell (Name)
The data in the sheet being used is all copied form other sheets and consolidated on this one. When I run the mail merge, it works as it should, but it works on ALL rows...even the ones that have just a function.
I have seen various examples of code to deal with this, but can't for the life of me figure out how to make it work and it is the last thing I need to call this project done!
Here is the code that I have now...have tried a few things, but none of them have worked... Thanks in advance for any help!
I am confident that someone has a solution to the below...
I have a mail merge that works perfectly except...
It will run each row regardless of content in trigger cell (Name)
The data in the sheet being used is all copied form other sheets and consolidated on this one. When I run the mail merge, it works as it should, but it works on ALL rows...even the ones that have just a function.
I have seen various examples of code to deal with this, but can't for the life of me figure out how to make it work and it is the last thing I need to call this project done!
Here is the code that I have now...have tried a few things, but none of them have worked... Thanks in advance for any help!
Code:
Private Sub btn_Annexmerge_Click()
Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, StrName As String
Dim myvalue As String, mergeselect As String
Dim fd As FileDialog
Dim strShortName As String
Dim strInitialDir As String
Dim wb As Workbook
strInitialDir = CurDir
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = CurDir & "\"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "All Word Files", "*.doc; *.docx"
If .Show = False Then
MsgBox "User cancelled without selecting. Process terminated."
ChDir (strInitialDir)
Exit Sub
End If
strPathAndFile = .SelectedItems(1)
End With
myvalue = InputBox("Enter Unit Name for Output File name", "FILE SAVE NAME")
With ActiveWorkbook
DataSource = .FullName
WordPath = strPathAndFile
wsName = .Sheets("FINANCE MEMO ROSTER").Name
StrName = myvalue
SavePath = .Path & "\"
End With
With WordApp
.Visible = True
.DisplayAlerts = wdAlertsNone
Set WordDoc = .Documents.Open(WordPath, AddToRecentFiles:=False)
With WordDoc
'Select Data Source and Complete Mail Merge
With .MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", WritePassWordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, SubType:=wdMergeSubTypeAccess, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
"Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & wsName & "$`", SQLStatement1:=""
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
.ActiveRecord = wdDefaultActiveRecord
End With
.Execute Pause:=False
End With
.Close SaveChanges:=False
End With
Exit Do
With .ActiveDocument
NewFileName = StrName & " - FINANCE FORM - " & Format(Date, "dd mmm yyyy") & ".docx"
.SaveAs SavePath + NewFileName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
'.SaveAs SavePath + NewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
Application.Dialogs(xlDialogPrinterSetup).Show
'.PrintOut
'.Close SaveChanges:=False
End With
.DisplayAlerts = wdAlertsNone
.Quit
End With
End Sub
Last edited by a moderator: