blitzd13
05-05-2015, 01:35 PM
Big Newbie looking for help. I did not find anything relating to this. Please be kind. I apologize in advance.
VBA With Excel TO Merge PDF based on filename oldest to newest
example:
1 dog
2 cat
3 bird
4 bugs
5 puppies
6 kittens
or
20150205 Dog
20150305 Cat
20150405 Bird
20150505 Bugs
Here is the Code I am using in excel Now.
Function cmdTest_Click()
Dim FOLDER As String
Dim FN As String
Dim objFinalPDF As Acrobat.CAcroPDDoc
Dim objSourcePDF As Acrobat.CAcroPDDoc
Dim colFiles As New Collection
Dim vFile As Variant
Dim FileCt As Integer
''''''''''''
'TROULBESHOOT
'if you get an error--it 's the file is not pdf---or corrupted
'
''''''''''''''''''''''''
FOLDER = Sheets("sheet1").Range("k2").Value & Sheets("sheet1").Range("k24").Value & "\"
'Sheets("sheet2").Range("f2") & Trim(Selection.Text) & "\"
RecursiveDir colFiles, FOLDER, "*.pdf", False 'you can change this to true if you want it to look in the sub folders too.
Set objFinalPDF = CreateObject("AcroExch.PDDoc") 'First pdf file to merge to
Set objSourcePDF = CreateObject("AcroExch.PDDoc") 'All other pdf files to merge from
FileCt = 0
For Each vFile In colFiles
If IsNull(vFile) Then GoTo Skip1
FileCt = FileCt + 1 'keeps track of file count
FN = vFile
If FileCt = 1 Then 'for first file only
objFinalPDF.Open (FN)
Else 'all other files to merge from
objSourcePDF.Open (FN)
If Not objFinalPDF.InsertPages(objFinalPDF.GetNumPages - 1, objSourcePDF, 0, objSourcePDF.GetNumPages, 0) Then
MsgBox "Problem merging all the pdf files. (" & FN & ")"
GoTo Exit1
End If
objSourcePDF.Close
End If
Skip1:
Next vFile
objFinalPDF.SAVE 1, FOLDER & " " & Sheets("sheet1").Range("k24").Value & ".pdf"
'Inputfolder = Sheets("sheet2").Range("f2").Value
Exit1:
objFinalPDF.Close
Set objFinalPDF = Nothing
Set objSourcePDF = Nothing
End Function
'This function helps you pull in all the file in the folder you select
Public Function RecursiveDir(colFiles As Collection, _
strfolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
' Dim strfolder As String
'Add files in strFolder matching strFileSpec to colFiles
strfolder = TrailingSlash(strfolder)
strTemp = Dir(strfolder & strFileSpec)
Do While strTemp <> vbNullString
colFiles.Add strfolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
strTemp = Dir(strfolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strfolder & strTemp) And vbDirectory) <> 0 Then colFolders.Add strTemp
End If
strTemp = Dir
Loop
'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strfolder & vFolderName, strFileSpec, True)
Next vFolderName
End If
End Function
VBA With Excel TO Merge PDF based on filename oldest to newest
example:
1 dog
2 cat
3 bird
4 bugs
5 puppies
6 kittens
or
20150205 Dog
20150305 Cat
20150405 Bird
20150505 Bugs
Here is the Code I am using in excel Now.
Function cmdTest_Click()
Dim FOLDER As String
Dim FN As String
Dim objFinalPDF As Acrobat.CAcroPDDoc
Dim objSourcePDF As Acrobat.CAcroPDDoc
Dim colFiles As New Collection
Dim vFile As Variant
Dim FileCt As Integer
''''''''''''
'TROULBESHOOT
'if you get an error--it 's the file is not pdf---or corrupted
'
''''''''''''''''''''''''
FOLDER = Sheets("sheet1").Range("k2").Value & Sheets("sheet1").Range("k24").Value & "\"
'Sheets("sheet2").Range("f2") & Trim(Selection.Text) & "\"
RecursiveDir colFiles, FOLDER, "*.pdf", False 'you can change this to true if you want it to look in the sub folders too.
Set objFinalPDF = CreateObject("AcroExch.PDDoc") 'First pdf file to merge to
Set objSourcePDF = CreateObject("AcroExch.PDDoc") 'All other pdf files to merge from
FileCt = 0
For Each vFile In colFiles
If IsNull(vFile) Then GoTo Skip1
FileCt = FileCt + 1 'keeps track of file count
FN = vFile
If FileCt = 1 Then 'for first file only
objFinalPDF.Open (FN)
Else 'all other files to merge from
objSourcePDF.Open (FN)
If Not objFinalPDF.InsertPages(objFinalPDF.GetNumPages - 1, objSourcePDF, 0, objSourcePDF.GetNumPages, 0) Then
MsgBox "Problem merging all the pdf files. (" & FN & ")"
GoTo Exit1
End If
objSourcePDF.Close
End If
Skip1:
Next vFile
objFinalPDF.SAVE 1, FOLDER & " " & Sheets("sheet1").Range("k24").Value & ".pdf"
'Inputfolder = Sheets("sheet2").Range("f2").Value
Exit1:
objFinalPDF.Close
Set objFinalPDF = Nothing
Set objSourcePDF = Nothing
End Function
'This function helps you pull in all the file in the folder you select
Public Function RecursiveDir(colFiles As Collection, _
strfolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
' Dim strfolder As String
'Add files in strFolder matching strFileSpec to colFiles
strfolder = TrailingSlash(strfolder)
strTemp = Dir(strfolder & strFileSpec)
Do While strTemp <> vbNullString
colFiles.Add strfolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
strTemp = Dir(strfolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strfolder & strTemp) And vbDirectory) <> 0 Then colFolders.Add strTemp
End If
strTemp = Dir
Loop
'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strfolder & vFolderName, strFileSpec, True)
Next vFolderName
End If
End Function