VBA - Opening or getting location for file where I don't know exactly where the file is saved or exactly what it is called

[excelquestion55]

At my job I have a bunch of products - about 1,600. For each product, we have recipe cards saved on excel. These are in a folder ("Meals") containing subfolders (eg. "Foils"). In these subfolder, are the excel recipe cards and another subfolder called "Archive" which has the old versions. If I have a product code eg. 324787, I would search this in file explorer and open the most up to date one. Can I do this on VBA? The other complication is that the recipes have no naming structure other than the fact that the 6 digit product code will be there somewhere. Thanks!

I have code to search for the file but I have no idea about how to then open the file - or get the file locations as I could then open it from this.

Sub SearchFiles()
Call Shell("explorer.exe " & Chr(34) & "search-ms:query= ***CODE*** &crumb=location: ***FILE LOCATION*** " & Chr(34), vbNormalFocus)
End Sub

 

[Gokhan Aycan]

Thanks for the debugging, much appreciated.

1. strProductCode: It is supposed to be numeric and 6 digits, which is checked in the first line. Exit Sub otherwise.

2. I usually use "Option Compare Text" to avoid letter case issues.

3. Great! I just gave advice on InStr() regarding the very same issue on some other post, and fell to it myself! Heh.

So just using "Option Compare Text" and "InStr() > 0" would eliminate all issues as far as I get it.

 

[Gokhan Aycan]

Made the changes to previous code. Added Option at the top and modified InStr() checks.

Option Explicit
Option Compare Text

Dim strProductCode As Variant
'Dim oDict As Scripting.Dictionary
Dim oDict As Object

Public Sub Find_Recipe()
    
    strProductCode = IIf(Len(CStr(ActiveCell.Value)) = 6 And IsNumeric(ActiveCell.Value), CStr(ActiveCell.Value), "")
    
    If strProductCode = "" Then
        MsgBox "Product code not suitable!", vbOKOnly, "Warning"
        Exit Sub
    End If
    
    'Dim fso As FileSystemObject
    'Set fso = New FileSystemObject
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim strFolder As String
    strFolder = "D:\Test VBA\Meals"

    'Set oDict = New Scripting.Dictionary
    Set oDict = CreateObject("Scripting.Dictionary")
    
    Call Get_SubFolders(fso.GetFolder(strFolder))
    
    Dim i As Long
    
    Dim Date_LastModified As Date
    Dim File_LastModified As String
    
    If oDict.Count > 0 Then
    
        Date_LastModified = oDict.Items()(0)
        File_LastModified = oDict.Keys()(0)
        
        Dim strInput As String
        
        strInput = ""
        
        For i = 0 To oDict.Count - 1
            strInput = strInput & Chr(10) & i + 1 & ") " & Right(oDict.Keys()(i), Len(oDict.Keys()(i)) - Len(strFolder) - 1) & Chr(10) & "     " & oDict.Items()(i)
            If DateDiff("s", Date_LastModified, oDict.Items()(i)) > 0 Then
                Date_LastModified = oDict.Items()(i)
                File_LastModified = oDict.Keys()(i)
            End If
        Next i
        
        strInput = "0) " & Right(File_LastModified, Len(File_LastModified) - Len(strFolder) - 1) & Chr(10) & "     " & Date_LastModified & Chr(10) & strInput
        
        Dim answer As Variant
re_input:
        answer = InputBox(strInput, "Select to Open", "0")
        
        If answer <> "" Then
        
            If IsNumeric(answer) Then
                answer = CInt(answer)
                If answer <= oDict.Count Then
                    If answer = 0 Then
                        Workbooks.Open (File_LastModified)
                    Else
                        Workbooks.Open (oDict.Keys()(answer))
                    End If
                Else
                    MsgBox "Please enter a valid number", vbOKOnly, "Warning"
                    GoTo re_input
                End If
            Else
                MsgBox "Please enter a valid number", vbOKOnly, "Warning"
                GoTo re_input
            End If
        End If
    End If
    
    Set oDict = Nothing
    Set fso = Nothing
    
End Sub

Private Function Get_SubFolders(ByVal oFolder As Variant) As Variant ' As Folder) as Folder
    
'    Dim oSubFolder As Folder
'    Dim oFile As File
    
    Dim oSubFolder As Variant
    Dim oFile As Variant
    
    For Each oSubFolder In oFolder.SubFolders
    
        Get_SubFolders oSubFolder
    
    Next oSubFolder
        
    For Each oFile In oFolder.Files
        If InStr(oFile.Name, strProductCode) > 0 And InStr(oFile.Path, ".xls") > 0 Then
            oDict(oFile.Path) = oFile.DateLastModified
        End If
    Next oFile
    
End Function

 

[GWteB]

So just using "Option Compare Text" and "InStr() > 0" would eliminate all issues as far as I get it.

1) Unlike Option Explicit, which affects at compile time, Option Compare Text affects at run time. Using it makes your procedures unportable. If someone places the code in another module (without this option), your code will still fail.
2) For the sake of readability that's the best option imo, unlike e.g. CBool(InStr())

 

[Gokhan Aycan]

I will just use UCase compare then or write a comment that the option is required for correct functioning.

Also, I have no idea if Text Compare work with diacritics, Turkish doesn't have them and English pretty much never use them on borrowed words, so idk.

 

[John_w]

@John_w, in the MSDos era I often struggled with this kind of thing, but (despite piping and redirectioning using Find and Sort) I could hardly ever solve this with one command line and had to use a batch file. I've just played around with it briefly, but I have the idea that there's something more involved to achieve the desired result when only using the command console. I am therefore curious about your solution.

Yes, it's difficult with a single DOS command line. The nearest I got was:

for /f "eol=: delims=" %F in ('DIR /B /S /A-D "C:\folder\path\*.xlsx"') do @echo %~tF;%F

then somehow convert the file dates to YYYYMMDD format (accounting for the regional date format) and pipe the output to a SORT command.

A better method is with this PowerShell command:

Get-ChildItem -File -Recurse 'C:\folder\path\*.xlsx' | Where-Object FullName -notmatch 'archive' | Select-Object -ExpandProperty FullName | Sort-Object LastWriteTime -Descending | Out-File -FilePath 'C:\folder\path\Powershell_Output.txt' -encoding ASCII

and read the output file with VBA. Here is the macro which implements the PowerShell method:

Public Sub Find_Product_Workbook3()

    Dim mainFolder As String, productCode As String
    Dim FSOfile As Object
    Dim outputFile As String
    Dim PScommand As String, PSoutput As Variant
    
    mainFolder = "C:\path\to\Meals\"            'change
    productCode = "123456"                      'change
    
    If Right(mainFolder, 1) <> "\" Then mainFolder = mainFolder & "\"
    
    outputFile = ThisWorkbook.Path & "\Powershell_Output.txt"
    PScommand = "Get-ChildItem -File -Recurse '" & mainFolder & "*" & productCode & "*.xlsx' | Where-Object FullName -notmatch 'archive' | Select-Object -ExpandProperty FullName | Sort-Object LastWriteTime -Descending" & _
                " | Out-File -FilePath '" & outputFile & "' -encoding ASCII"
    
    CreateObject("Wscript.Shell").Run "powershell.exe -command " & PScommand, 0, True
       
    With CreateObject("Scripting.FileSystemObject")
        Set FSOfile = .OpenTextFile(outputFile)
        If Not FSOfile.AtEndOfStream Then PSoutput = Split(FSOfile.ReadAll, vbCrLf)
        FSOfile.Close
        .DeleteFile outputFile
    End With

    If Not IsEmpty(PSoutput) Then
        MsgBox "Found " & PSoutput(0), vbInformation, "Find Product workbook"
        ActiveSheet.Range("A1").Value = PSoutput(0)
    Else
        MsgBox "Excel workbook with file name containing product code '" & productCode & "' not found in " & mainFolder & " and its subfolders", vbExclamation, "Find Product workbook"
    End If
    
End Sub

 

[John_w]

Small change to the PowerShell command to exclude the "\Archive\" folder, but not files with Archive in their name:
Get-ChildItem -File -Recurse 'C:\folder\path\*.xlsx' | Where-Object FullName -notmatch '\\archive\\' | Select-Object -ExpandProperty FullName | Sort-Object LastWriteTime -Descending | Out-File -FilePath 'C:\folder\path\Powershell_Output.txt' -encoding ASCII

In the above macro replace:

    PScommand = "Get-ChildItem -File -Recurse '" & mainFolder & "*" & productCode & "*.xlsx' | Where-Object FullName -notmatch 'archive' | Select-Object -ExpandProperty FullName | Sort-Object LastWriteTime -Descending" & _
                " | Out-File -FilePath '" & outputFile & "' -encoding ASCII"

with:

    PScommand = "Get-ChildItem -File -Recurse '" & mainFolder & "*" & productCode & "*.xlsx' | Where-Object FullName -notmatch '\\archive\\' | Select-Object -ExpandProperty FullName | Sort-Object LastWriteTime -Descending" & _
                " | Out-File -FilePath '" & outputFile & "' -encoding ASCII"

 

[GWteB]

@John_w, thanks for sharing. No doubt the OP has plenty of choice now ...