VBA Export diferent excel files to pdf and then combine them to one file

[estrunfina_amarela]

Hi,

I know little of this, wondering if someone could help me.

I 'm trying to create something like this thread Append to pdf VBA


I've been searching for something like this, but just for one subfolder.


How can i use this routine, but calling it inside another routine (let's say main routine) and imputing the folder path, where the pdfs are, from the main routine.


I have a main routine that makes individual pdf files out of multiple excel files, into a subfolder.

That routine start's by asking the user:
-path1 - of excel files
-path2 - for resulting pdf files

I think this could work just like I need if I input path2 inside pdftkMerge

Tried to use it, but didn't succeed



The code in the older thread:


'PDFtk Server Examples
Sub MergeToPDFtk2()
Dim a, f, i As Long, p As String
Dim p2 As String, r As String, fso As Object
Dim s As String, k As String

'Parent folder
p = ThisWorkbook.Path & "\"
p = "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\"

'Folder to copy merged pdfs in subfolders to, p2 initional, and r actual.
p2 = p & "MergedPDFs"
If Dir(p2, vbDirectory) = "" Then MkDir p2
'Make a new folder in p2 to store this run's merged pdf files.
Do
i = i + 1
r = p2 & "\Run" & i & "\"
Loop Until Dir(r, vbDirectory) = ""
MkDir r

Set fso = CreateObject("Scripting.FileSystemObject")

'SubFolders Array
f = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & p & """" & " /ad/b/s").StdOut.ReadAll, vbCrLf)
'Add parent folder to f:
f(UBound(f)) = Left(p, Len(p) - 1)
'Debug.Print Join(f, vbCrLf), "done"

'Merge pdfs in subfolders, save merged file in r folder with subfolder's name.pdf.
For i = 0 To UBound(f)
k = f(i) & "\" & Dir(f(i) & "\*.pdf")
If InStr(f(i), p2 & "\") = 0 And Dir(f(i) & "\*.pdf") <> "" Then
'Need 2 pdfs to merge or pdfill slows and may error
If Dir <> "" Then 'at least 2 pdfs files exist
s = "pdftk " & _
"""" & f(i) & "\*.pdf" & """" & _
" cat output " & """" & _
"""" & r & fso.GetFolder(f(i)).Name & ".pdf" & """"
Shell s, vbNormal
Else
FileCopy k, (r & fso.GetFolder(f(i)).Name & ".pdf")
End If
End If
Next i
Set fso = Nothing
MsgBox "PDF files merged to folder: " & r
End Sub




The code I'm using to export excel files as pdf:


Sub ExcelSaveAsPDF()

Dim StrPath As String
Dim xStrFile1, xStrFile2 As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath, xWBName As String
Dim xBol As Boolean
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the Excel files you want to convert:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a destination folder to save the converted files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
StrPath = xSPath & "\"
xStrFile1 = Dir(StrPath & "*.*")




Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While xStrFile1 <> ""
xBol = False
If Right(xStrFile1, 3) = "xls" Then
Set xWbk = Workbooks.Open(FileName:=StrPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xls", "_pdf")
xBol = True
ElseIf Right(xStrFile1, 3) = "XLS" Then
Set xWbk = Workbooks.Open(FileName:=StrPath & xStrFile1)
xbwname = Replace(xStrFile1, ".XLS", "_pdf")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(FileName:=StrPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xlsx", "_pdf")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsm" Then
Set xWbk = Workbooks.Open(FileName:=StrPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xlsm", "_pdf")
xBol = True
End If



If xBol Then
xWbk.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xRPath & xbwname & ".pdf"
xWbk.Close SaveChanges:=False
End If
xStrFile1 = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[John_w]

Try this code. I've tidied up your macro which exports the Excel files as PDFs and it now calls Merge_PDFs which merges them to "All_PDFs_Merged.pdf" in the destination folder.

The PDFtk Server Manual doesn't specify the maximum number of input PDF files, however I suspect it is limited by the maximum command line length which is 8191 characters. If you have many PDFs in the destination folder and this length is exceeded the code would need to be modified to merge the PDFs in batches.

Option Explicit

Const Q As String = """"

Public Sub ExcelSaveAsPDFandMerge()

    Dim FD As FileDialog
    Dim file As String, p As Long
    Dim Wbk As Workbook
    Dim sourcePath As String, destPath As String
    Dim PDFfile As String
    
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .Title = "Please select the folder contains the Excel files you want to convert:"
        .InitialFileName = "C:\"
        If Not .Show Then Exit Sub
        sourcePath = .SelectedItems.Item(1) & "\"
        
        .Title = "Please select a destination folder to save the converted files:"
        .InitialFileName = "C:\"
        If Not .Show Then Exit Sub
        destPath = .SelectedItems.Item(1) & "\"
    End With
    
    file = Dir(sourcePath & "*.*")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Do While file <> vbNullString
        p = InStrRev(file, ".")
        Select Case LCase(Mid(file, p))
            Case ".xls", ".xlsx", ".xlsm"
                Set Wbk = Workbooks.Open(Filename:=sourcePath & file)
                PDFfile = Left(file, p - 1) & "_pdf.pdf"
                Wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=destPath & PDFfile
                Wbk.Close SaveChanges:=False
        End Select
        file = Dir
    Loop
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Merge_PDFs destPath
    
    MsgBox "Done"
    
End Sub


Private Sub Merge_PDFs(PDFfolder As String)

    Dim Wsh As Object 'WshShell
    Dim inputPDFs As String, outputPDF As String
    Dim PDFfile As String
    Dim command As String
    
    outputPDF = PDFfolder & "All_PDFs_Merged.pdf"
    If Dir(outputPDF) <> vbNullString Then Kill outputPDF
    
    inputPDFs = ""
    PDFfile = Dir(PDFfolder & "*.pdf")
    While PDFfile <> vbNullString
        inputPDFs = inputPDFs & Q & PDFfile & Q & " "
        PDFfile = Dir
    Wend
    
    'Merge PDFs with cat

    command = "CD /D " & Q & PDFfolder & Q & " & PDFtk " & inputPDFs & " cat output " & Q & outputPDF & Q
    Set Wsh = CreateObject("WScript.Shell") 'New WshShell
    Wsh.Run "cmd /c " & command, 0, True
    
End Sub

 

[estrunfina_amarela]

Hi,

Thank you very much this works just fine!!

 

[estrunfina_amarela]

Hi,

So I have a problem with this script.
Wen I run in my drive C and choose final folder on C, the "Merge_PDFs" works perfectly, but if the final folder is on a network path it doesn't work.

How can I change to work on network path?

 

[John_w]

Untested, by try changing the CD /D in the command string to pushd:

    command = "pushd " & Q & PDFfolder & Q & " & PDFtk " & inputPDFs & " cat output " & Q & outputPDF & Q

 

[estrunfina_amarela]

Thank you John!

It works very well!

 

[estrunfina_amarela]

How can define the name of the final merged pdf file to be same name name as the original folder?




tryed to add this but didn't succeed


---- added to main sub

nomeSourceFolder = GetFolderNameFromPath(sourcePath)

Merge_PDFs destPath, nomeSourceFolder


---- add to sub merge_pdfs


outputPDF = PDFfolder & SourcefolderName & "All_PDFs_Merged.pdf"




---- added a function

Function GetFolderNameFromPath(folderPath As String) As String

Dim lastPathSeparatorPosition As Long, folderPathLength As Long, folderNameLength As Long

lastPathSeparatorPosition = InStrRev(folderPath, Application.PathSeparator)
folderPathLength = Len(folderPath)
folderNameLength = folderPathLength - lastPathSeparatorPosition
GetFolderNameFromPath = Right(folderPath, folderNameLength)

End Function

 

[John_w]

How can define the name of the final merged pdf file to be same name name as the original folder?

Replace:

    outputPDF = PDFfolder & "All_PDFs_Merged.pdf"

with:

    Dim folders As Variant   
    folders = Split(PDFfolder, "\")
    outputPDF = PDFfolder & folders(UBound(folders) - 1) & ".pdf"

Please use CODE tags.

 

[estrunfina_amarela]

Thanks very much.

I only changed it to be the name of the source files.

Private Sub Merge_PDFs(PDFfolder As String, sourcePath As String) 

folders = Split(sourcePath, "\")   

'