Thanks for reaching out Tom!
I have a function to open the PDF, and I have the input box collecting the data properly. The rest of the code is something I found on another part of the forums and was trying to modify it to work. So far it does not compile or work! Any help is appreciated.
Option Explicit
'WIP TO open PDF Files from cell value
Function OpenAnyFile(strPath As String)
Set objShell = CreateObject("Shell.Application")
objShell.Open (strPath)
End Function
'// Dimmed at module level; errr... mostly cuz I can't think of how you'd pass it recursvely //
Dim aryFileNames() As String
Public Sub example()
Dim FSO As Object ' FileSystemObject
Dim fsoFolder As Object ' Folder
Dim fsoSubFolder As Object ' Folder
Dim fsoFile As Object ' File
Dim WB As Workbook
Dim n As Long
Dim lPrefaceNo As String
Dim Preface As String
Dim FullPath As String
lPrefaceNo = Application.InputBox(prompt:="Select a Contract", Title:="Pull a Contract", Type:=8)
If lPrefaceNo <> Range("B2:B") Then
MsgBox "Bad Input"
Exit Sub
End If
'// Turn pattern into a string with any needed leading zeros //
Preface = Format(lPrefaceNo, "@")
'// However you want to get a reference to the initial path, this is the topmost //
'// folder to be searched. //
FullPath = "P:\Purchase Orders DNA"
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(FixPath(FullPath)) Then
MsgBox "Bad Path"
Exit Sub
End If
Set fsoFolder = FSO.GetFolder(FixPath(FullPath))
ReDim aryFileNames(0 To 0)
'// Call a recursive function, where we'll build an array of fullnames. //
Call FindMatchingFiles(FSO, fsoFolder, Preface)
'// Ditch the last element, which will be an empty string. //
ReDim Preserve aryFileNames(0 To UBound(aryFileNames) - 1)
'// Then loop thru the array,... //
For n = LBound(aryFileNames) To UBound(aryFileNames)
'// Open wb, do stuff, close //
Next
End Sub
' As FileSystemObject, As Folder
Function FindMatchingFiles(fs As Object, fsFol As Object, Pattern As String)
Dim fsoSubFolder As Object ' Folder
Dim fsoFile As Object ' File
Dim FileNameIncStop As String
'// For each file in the folder passed, ... //
For Each fsoFile In fsFol.Files
'// ...grab the filename up to.including the dot. //
FileNameIncStop = Left(fsoFile.Name, InStrRev(fsoFile.Name, "."))
If Len(FileNameIncStop) > Len(Pattern) Then
If Left(FileNameIncStop, Len(Pattern)) = Pattern _
And Not Mid(FileNameIncStop, Len(Pattern) + 1) Like "[0-9]*" Then
'// Add an element and fill it w/the file's fullname //
ReDim Preserve aryFileNames(0 To UBound(aryFileNames) + 1)
aryFileNames(UBound(aryFileNames) - 1) = fsoFile.Path
End If
End If
Next
'// When out of files to check, re-call the function, passing a subfolder to be //
'// searched. //
For Each fsoSubFolder In fsFol.SubFolders
Call FindMatchingFiles(fs, fsoSubFolder, Pattern)
Next
End Function
Function FixPath(Path As String, Optional StripSeperator As Boolean = False) As String
Do While Right(Path, 1) = "\"
Path = Left(Path, Len(Path) - 1)
Loop
If StripSeperator Then
FixPath = Path
Else
FixPath = Path & "\"
End If
End Function
LinkBack URL
About LinkBacks
Register To Reply
Originally Posted by Auruin
Bookmarks