VBA Code to merge exported pdf files

Copper Contributor

Value of "i" is lookup value. So this generates a table for each "i" For this the following code generates individual pdf files for each "i", but I need all files merged into a single pdf file. Please help me to edit this code.

 

Sub tt()
    
    Dim i As Integer
    Dim fname As String

    For i = 2 To 6
        
        Sheet2.Cells(2, "B").Value = Sheet1.Cells(i, 1).Value
        fname = Sheet1.Cells(i, 1).Value & "_" & "Result"
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "G:\1\" & fname & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    
    Next
    
    
End Sub

 

1 Reply

@Aj_2653 

Here's a code from the Internet, unfortunately I don't know from which (a long time ago :), it should work if you adapt it to your digital environment.

OptionExplicit
sub multidoc()
  Dim fso As Object, WshShell As Object
  Dim strFolder As String, i As Long
  Dim strMulti As String, strCommand As String, strGS As String
  Set fso = CreateObject("Scripting.FileSystemObject")
 'Adjust path to gswin32c.exe
  strGS = "C:\Program Files\Text Processing\Ghostscript\gs8.53\bin\gswin32c.exe"
  'strGS = "C:\Programme\gs\gs9.26\bin\gswin64c.exe"
 ' Customize output folder
  strFolder = "E:\Temp\Nikolino test"
  Adjust with Table1'
   'Column A : file names with full path
   'Column B : file names with full path
    For i = 2 To .UsedRange.Rows.Count
      If fso.FileExists(.Cells(i, 1).Value) And fso.FileExists(.Cells(i, 2).Value) Then
        strMulti = " " & Chr(34) & .Cells(i, 1).Value & Chr(34) & " " & Chr(34) & .Cells(i, 2).Value & Chr(34)
        strFolder = fso.getfolder(strFolder).ShortPath
        strGS = fso.GetFile(strGS).ShortPath
        strCommand = strGS & " -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=" & Chr(34)
        strCommand = strCommand & strFolder & "\"
       'Output file name = name of file in column A
        strCommand = strCommand & fso.GetFile(.Cells(i, 1).Value).Name & Chr(34) & strMulti
        Debug.Print strCommand
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run strCommand, 0, True
        Set WshShell = Nothing
      End If
    Next
  End With
  Set fso = Nothing
  MsgBox "Done"
end sub

Be sure to remove spaces (folder name and PDF files).

 

Hope I could help you with these information.

 

NikolinoDE

I know I don't know anything (Socrates)