View Full Version : [SOLVED:] Merging Error
branston
02-11-2022, 06:42 AM
Hi
I am trying to merge some pdf files in a folder but am getting a "subscript out of range" error for the below:
'SubFolders Array
f = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & p & """" & " /ad").StdOut.ReadAll, vbCrLf)
'Add parent folder to f:
f(UBound(f)) = Left(p, Len(p) - 1) (THIS LINE IS HIGHLIGHTED by the compiler)
I have checked the library references and they are all there. I have re-named the files to exclude any special characters that could cause issues. (I am using pdftk merge to help me merge the files.)
Can anyone help?
Paul_Hossler
02-11-2022, 09:35 AM
when you hit that line, what does the watch window show for f() and p?
branston
02-11-2022, 10:54 AM
Hi Paul
Sorry not 100% sure you mean this but if I add a watch I get this in the window
f(UBound(f)) = Left(p, Len(p) - 1) : <Subscript out of range> : Variant/Integer : Paper1.iSubfolderss
You don't have to add anything
sn = filter(Split(CreateObject("Wscript.Shell").Exec("cmd /c dir G:\OF\*.pdf /b/s").StdOut.ReadAll, vbCrLf),"pdf")
msgbox sn(ubound(sn))
p45cal
02-13-2022, 05:15 AM
Whats the betting p doesn't contain a valid path?
Also it won't like:
& " /ad"
it'll want to see:
& " /a/d"
or:
& " /a:d"
depending on what you want.
No
"/ad"
means: only (sub)directory names
"/a-d"
Means no (sub)directory names
But in this case it is redundant if the search string contains "*.pdf"
branston
02-13-2022, 10:27 AM
Thanks guys. I've taken away those switches but still get the error. Really confused now especially since this code was working fine a few months ago. I've tried snb's suggestions as well but now get a 'type mismatch' error. Here is a longer snippet of the original code if anyone can see what the issue is as I am at a loss.:(
Sub iSubfolders() Dim a, f, i As Long, p As String
Dim p2 As String, r As String, fso As Object
'Parent folder
p = ThisWorkbook.Path & "\"
'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.
'SubFolders Array
a = aFiles(p, "/ad", True)
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)
TIA
just delete /ad and it wil work fine.
Please read the comments I wrote about the switches; I didn't write them to be ignored.
Paul_Hossler
02-13-2022, 07:04 PM
Slightly different approach
Copies all PDFs in all subfolder to a single folder
Option Explicit
Dim oFSO As Object, oPath As Object
Dim sPath As String, sPathPDF As String
Sub MergePDFs()
sPath = ThisWorkbook.Path & Application.PathSeparator
sPath = "D:\Test\" ' <<<<<<<<<<<<<<<<<<< testing
sPathPDF = sPath & "MergePDFs"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(sPath) Then
MsgBox sPath & " doesn't exist"
Exit Sub
End If
If Not oFSO.FolderExists(sPathPDF) Then oFSO.CreateFolder (sPathPDF)
Set oPath = oFSO.GetFolder(sPath)
Call pvtCopyFiles(oPath)
Set oPath = Nothing
Set oFSO = Nothing
End Sub
Private Sub pvtCopyFiles(oFolderIn As Object)
Dim oFolder As Object
If LCase(oFolderIn.Path) = LCase(sPathPDF) Then Exit Sub
Call oFSO.CopyFile(oFolderIn.Path & "\*.pdf", sPathPDF, True)
For Each oFolder In oFolderIn.SubFolders
Call pvtCopyFiles(oFolder)
Next
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.