#1
|
|||
|
|||
Mail Merge Code
I am trying to get this code to work (novice to vba ) this was something shared.
I keep getting an error 5174 couldn't find your file. I know the location and file names are correct any help Code:
Option Explicit Const FOLDER_SAVED As String = "C:\Users\david\Desktop\PhotoRelease\" Const SOURCE_FILE_PATH As String = "C:\Users\david\Desktop\PhotoRelease\ScoutRoster.xls\" Sub MailMerge_Automation() Dim MainDoc As Document, TargetDoc As Document Dim dbPath As String Dim recordNumber As Long, totalRecord As Long Set MainDoc = ActiveDocument With MainDoc.MailMerge '// if you want to specify your data, insert a WHERE clause in the SQL statement .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [database$]" totalRecord = .DataSource.RecordCount For recordNumber = 1 To totalRecord With .DataSource .ActiveRecord = recordNumber .FirstRecord = recordNumber .LastRecord = recordNumber End With .Destination = wdSendToNewDocument .Execute False Set TargetDoc = ActiveDocument TargetDoc.SaveAs2 FOLDER_SAVED & .DataSource.DataFields("Name").Value & ".docx", wdFormatDocumentDefault TargetDoc.ExportAsFixedFormat FOLDER_SAVED & .DataSource.DataFields("Name").Value & ".pdf", exportformat:=wdExportFormatPDF TargetDoc.Close False Set TargetDoc = Nothing Next recordNumber End With Set MainDoc = Nothing End Sub |
#2
|
||||
|
||||
I find it hard to believe that
Code:
Const SOURCE_FILE_PATH As String = "C:\Users\david\Desktop\PhotoRelease\ScoutRoster.xls\"
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Gmayor
@gmayor
Ok I did that still getting the error. Code:
Const FOLDER_SAVED As String = "C:\Users\david\Desktop\PhotoRelease" Const SOURCE_FILE_PATH As String = "C:\Users\david\Desktop\PhotoRelease\ScoutRoster.xls" |
#4
|
||||
|
||||
OK - lets add some error handling and then you can see where it is going wrong. With a mock-up of your configuration, the following does work. It will correct for illegal filename characters but makes no provision for duplicated names:
Code:
Option Explicit Sub MailMerge_Automation() 'Graham Mayor - https://www.gmayor.com - Last updated - 04 Oct 2020 Dim FOLDER_SAVED As String Dim SOURCE_FILE_PATH As String Dim FSO As Object Dim MainDoc As Document, TargetDoc As Document Dim dbPath As String Dim strName As String Dim recordNumber As Long, totalRecord As Long Dim arrInvalid() As String Dim lng_Index As Long FOLDER_SAVED = Environ("USERPROFILE") & "\Desktop\PhotoRelease\" SOURCE_FILE_PATH = Environ("USERPROFILE") & "\Desktop\PhotoRelease\ScoutRoster.xls" arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|") If Documents.Count = 0 Then MsgBox "No document open!", vbCritical Exit Sub End If If ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument Then MsgBox "The current document is not a mailmerge document!", vbCritical Exit Sub End If Set FSO = CreateObject("Scripting.FileSystemObject") If Not FSO.FolderExists(FOLDER_SAVED) Then MsgBox "The folder" & vbCr & FOLDER_SAVED & vbCr & "does not exist!", vbCritical Exit Sub End If If Not FSO.FileExists(SOURCE_FILE_PATH) Then MsgBox "The workbook" & vbCr & SOURCE_FILE_PATH & vbCr & "is not present!", vbCritical Exit Sub End If Set MainDoc = ActiveDocument With MainDoc.MailMerge .OpenDataSource Name:=SOURCE_FILE_PATH, _ ConfirmConversions:=False, _ ReadOnly:=False, _ LinkToSource:=True, _ AddToRecentFiles:=False, _ Format:=wdOpenFormatAuto, _ Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & _ SOURCE_FILE_PATH & _ ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLE" _ , SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _ wdMergeSubTypeAccess totalRecord = .DataSource.RecordCount .Destination = wdSendToNewDocument .SuppressBlankLines = True For recordNumber = 1 To totalRecord With .DataSource .FirstRecord = recordNumber .LastRecord = recordNumber .ActiveRecord = recordNumber strName = .DataFields("Name").value MainDoc.MailMerge.Execute Pause:=False Set TargetDoc = ActiveDocument If Not strName = "" Then TargetDoc.SaveAs2 FOLDER_SAVED & strName & ".docx", wdFormatDocumentDefault TargetDoc.ExportAsFixedFormat FOLDER_SAVED & strName & ".pdf", ExportFormat:=wdExportFormatPDF Else MsgBox "There is no filename available for this record!", vbCritical End If TargetDoc.Close 0 NextRecord: End With DoEvents Next recordNumber End With Set MainDoc = Nothing Set TargetDoc = Nothing Set FSO = Nothing End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
Thanks
That worked thanks.. I had an space that i did not see if the one name. This pointed it out and now it works great.
Thanks so much for your help. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBA code to CC multiple people in mail merge by word | kuankailok | Mail Merge | 3 | 05-04-2020 02:08 PM |
VBA code not in module of new document produced by mail merge | MP1989 | Mail Merge | 3 | 09-10-2018 02:16 PM |
Mail Merge Code Issue | Andrewwill | Mail Merge | 6 | 01-06-2018 10:25 PM |
Mail Merge Code (Default Display) | ochiha_ita | Mail Merge | 3 | 04-22-2013 04:04 AM |
Mail merge Field Code Manipulation | macjnr | Mail Merge | 0 | 09-10-2009 11:37 AM |