Search a pdf file depended on textbox value in multiple folders and subfolders

[petroj02]

Hello,
I would like to find and open pdf file which is located in many Folders and subfolders, The file Name I would like to find depends on user Input to TextBox. These Folders and sobfolders are created by the date/month/day

Here is a code how I create the path for new file


Sub createDateFolder() ' modul vytvarejici podslozku vzdy podle data
Dim fsoObj As Object, thedate As String
thedate = Format(Date, "DD/MM/YYYY")
If Len(Dir("V:\CGC_DATA\Orders\" & Year(Date), vbDirectory)) = 0 Then
MkDir "V:\CGC_DATA\Orders\" & Year(Date)
End If
If Len(Dir("V:\CGC_DATA\Orders\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
MkDir "V:\CGC_DATA\Orders\" & Year(Date) & "\" & MonthName(Month(Date), False)
End If
enddir = ("V:\CGC_DATA\Orders\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & thedate & "\") 'cesta podslozky
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(enddir) Then 'kdyz podslozka neexistuje modul ji vytvori
.CreateFolder (enddir)
End If
End With
End Sub

here is a code I have right now for finding the existing pdf file. Problem is that this way I can find only file from "today"...



Sub openOldList(ByVal oldList As String)
Dim thedate As String
thedate = Format(Date, "DD/MM/YYYY")
ThisWorkbook.FollowHyperlink "V:\CGC_DATA\Orders\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & thedate & "\" & oldList & ".pdf"
End Sub


But I am not able to find the way how to Loop all existing Folders after this path "V:\CGC_DATA\Orders\" and in These all Folders to find and open the pdf file I am searching for in TextBox.

I hope someone can pull me closer to my goal

[Kenneth Hobs]

If you want to find the first file starting at the parent folder:

Sub Main()
openOldList "ken"
End Sub


Sub openOldList(oldList$)
Dim fso As Object, a, s$
Set fso = CreateObject("Scripting.FileSystemObject")

s = "V:\CGC_DATA\Orders\" & oldList & ".pdf"
's = "C:\Users\lenovo1\Dropbox\Excel\pdf\" & oldList & ".pdf"

'Descending Order by drive\path\filename.ext. Do not list folders.
a = aFFs(s, "/O-N /A-D", True) 'True, check all subfolders.
'If IsArray(a) Then ThisWorkbook.FollowHyperlink (a(0))
If IsArray(a) Then Shell "cmd /c " & """" & a(0) & """", vbNormal
End Sub


'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
Optional tfSubFolders As Boolean = False) As Variant

Dim s As String, a() As String, v As Variant
Dim b() As Variant, i As Long

If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
Else
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
End If

a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
Debug.Print myDir & " not found."
Exit Function
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr

For i = 0 To UBound(a)
If Not tfSubFolders Then
s = Left$(myDir, InStrRev(myDir, "\"))
'add the folder name
a(i) = s & a(i)
End If
Next i
aFFs = sA1dtovA1d(a)
End Function


Function sA1dtovA1d(strArray() As String) As Variant
Dim varArray() As Variant, i As Long
ReDim varArray(LBound(strArray) To UBound(strArray))
For i = LBound(strArray) To UBound(strArray)
varArray(i) = CVar(strArray(i))
Next i
sA1dtovA1d = varArray()
End Function

[Leith Ross]

Hello petroj02,

This will search all subfolders and return the first file found matching the path and file name. Both the file name and the date are passed to the openOldList. The macro can be setup to allow you to enter a date when it runs, if you like. Let me know.





Private oShell As Object


Function FindFile(ByVal FolderPath As Variant, ByVal FileName As String, Optional ByVal SubfolderLevel As Long) As String


Dim oFile As Object
Dim oFiles As Object
Dim oFolder As Variant
Dim oShell As Object

If oShell Is Nothing Then
Set oShell = CreateObject("Shell.Application")
End If

Set oFolder = oShell.Namespace(FolderPath)
If oFolder Is Nothing Then
MsgBox "The Folder '" & FolderPath & "' Not Found.", vbCritical
Exit Function
End If

' Return all files in the parent folder.
Set oFiles = oFolder.Items
oFiles.Filter 64, FileName

For Each oFile In oFiles
If oFile.Name = FileName Then
FindFile = oFile.Path
Exit Function
End If
Next oFile

' Search all folders in this folder.
oFiles.Filter 32, "*"
If SubfolderLevel <> 0 Then
For Each oFolder In oFiles
Call FindFile(oFolder, FileName, SubfolderLevel - 1)
Next oFolder
End If

End Function


Sub openOldList(ByVal OldList As String, Byval FileDate As Variant)

Dim Path As String
Dim FileFound As String
Dim FileDate As Variant
Dim FileName As Variant


Const Search_All As Long = -1


If Not IsDate(FileDate) Then
MsgBox "The File Date is Invalid."
Exit Sub
End If


Path = "V:\CGC_DATA\Orders\" & Format(FileDate,"yyyy\MMMM\") & Format(FileDate, "dd-MM-yyyy\")
FileName = Path & OldList & ".pdf"


FileFound = FindFile(Path, FileName, Search_All)


If FileFound <> "" Then
ThisWorkbook.FollowHyperlink FileFound
Else
MsgBox "'" & FileName & "' Not Found.", vbExclamation
End If


End Sub

[petroj02]

Hello,
thank you both for your response. This is really high level of VBA for me, anyway It looks like that Kenneth approach for me is the great one and it works fine, because user wont probably know when the order have been done in past. The date saving method for orders is just for mapping work flow. Also there should be always unique ID for order.
I really thank you both of you for help...

Edit:I have found, that as we have our names for months in czech language e.g. únor for february, březen for march and so on... There is problem for looping folders with special marks like ´ and ˇ,because VBA saves folder by month depending on OS language...