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

New Member
Joined
Sep 15, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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
 
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. :p

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

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Made the changes to previous code. Added Option at the top and modified InStr() checks.

VBA Code:
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
 
Upvote 0
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())
 
Upvote 0
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.
 
Upvote 0
@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:
Code:
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:
Code:
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:

VBA Code:
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
 
Upvote 0
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:
VBA Code:
    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:
VBA Code:
    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"
 
Upvote 0
@John_w, thanks for sharing. No doubt the OP has plenty of choice now ... :biggrin:
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top