Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-03-2020, 04:57 AM
dlafko1 dlafko1 is offline Mail Merge Code Windows 10 Mail Merge Code Office 2016
Advanced Beginner
Mail Merge Code
 
Join Date: Apr 2019
Posts: 31
dlafko1 is on a distinguished road
Default 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
Reply With Quote
  #2  
Old 10-03-2020, 05:32 AM
gmayor's Avatar
gmayor gmayor is offline Mail Merge Code Windows 10 Mail Merge Code Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

I find it hard to believe that
Code:
Const SOURCE_FILE_PATH As String = "C:\Users\david\Desktop\PhotoRelease\ScoutRoster.xls\"
is correct. Try removing the backslash from the end of the filename.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 10-03-2020, 06:55 AM
dlafko1 dlafko1 is offline Mail Merge Code Windows 10 Mail Merge Code Office 2016
Advanced Beginner
Mail Merge Code
 
Join Date: Apr 2019
Posts: 31
dlafko1 is on a distinguished road
Default 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"
Reply With Quote
  #4  
Old 10-04-2020, 01:42 AM
gmayor's Avatar
gmayor gmayor is offline Mail Merge Code Windows 10 Mail Merge Code Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #5  
Old 10-04-2020, 05:25 AM
dlafko1 dlafko1 is offline Mail Merge Code Windows 10 Mail Merge Code Office 2016
Advanced Beginner
Mail Merge Code
 
Join Date: Apr 2019
Posts: 31
dlafko1 is on a distinguished road
Default 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.
Reply With Quote
Reply

Thread Tools
Display Modes


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
Mail Merge Code 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 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

Other Forums: Access Forums

All times are GMT -7. The time now is 10:52 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft