VBA search for files in multiple folders from Cell input

[nogarth]

Hi i hope someone can help. i had a file few years ago that a friend worked on and trying to recreate it for some work im doing. i have a list of file names in Row A i needs to check in 3 different locations which is B, C or D which are different folder locations to see if a file is in there. i remember we originally trimmed the extension off the lookup file of A the output the found file with extension in B, C or D.

the folder locations are all the same except the sub folder eg. c:\temp\JPG c:\temp\PNG etc i remember we read in the line B1 C1 incase the folder ever changed etc.

if the file did not exist it would leave it blank and moved on.

i do not have any of the original code we used so this is all from scratch and trying to remember what we did 20+ years ago.

Im hopeing one of you gurus out there have something already out that can be tweaked to do the job and help me out.

Hopefully this makes sence.

 

[Trebor76]

Hi nogarth,

Welcome to the MrExcel!!

I'm not 100 percent sure on some things but as a start try this:

Option Explicit
Sub Macro1()

    Dim objFSO As Object
    Dim varExtn As Variant, varExtns As Variant
    Dim strFileName As String
    Dim rngCell As Range
    Dim lngLastRow As Long, i As Long
    Dim ws As Worksheet
    
    Application.ScreenUpdating = True
    
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data. Change to suit if necessary.
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    lngLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    varExtns = ws.Range("B1:D1") 'Range of file extensions for each file to be checked against.
    
    For Each rngCell In ws.Range("A2:A" & lngLastRow)
        strFileName = objFSO.GetFileName(rngCell)
        For Each varExtn In varExtns
            i = i + 1
            'If the file name does not exist in the directory with any extension, then...
            If Dir("C:\Temp\" & CStr(varExtn) & "\" & rngCell & "*.*", vbDirectory) = "" Then
                '...flag the cell with the text 'Does Not Exist'
                rngCell.Offset(0, i).Value = "Does Not Exist"
            'Else...
            Else
                '...flag the cell with the text 'Does Exist'
                rngCell.Offset(0, i).Value = "Does Exist"
            End If
        Next varExtn
        i = 0
    Next rngCell
    
    Application.ScreenUpdating = False

End Sub

Regards,

Robert

 

[Micron]

i remember we originally trimmed the extension off the lookup file of A the output the found file with extension in B, C or D.

The way I read that, there is something missing but it implies that you want to look for files in subfolders that contain the values in col A but ignore the extension. In other words, look for "filename" and not filename.zip in those folders. I may be wrong but I don't think the posted code will do that if it's a requirement.

 

[Trebor76]

Actually this line...

If Dir("C:\Temp\" & CStr(varExtn) & "\" & rngCell & "*.*", vbDirectory) = "" Then

...should be this:

If Dir("C:\Temp\" & CStr(varExtn) & "\" & strFileName & "*.*", vbDirectory) = "" Then

 

[nogarth]

Actually this line...

If Dir("C:\Temp\" & CStr(varExtn) & "\" & rngCell & "*.*", vbDirectory) = "" Then

...should be this:

If Dir("C:\Temp\" & CStr(varExtn) & "\" & strFileName & "*.*", vbDirectory) = "" Then

many thanks for your help here but ive just woke up and quick tried it. it does and doesn't work if i remove the extension manually on the column A it will pick up the file if not it wont. i remember we had to do a trim on each line to remove the extension as each line could be a file from the input

 

[Trebor76]

i remember we had to do a trim on each line to remove the extension as each line could be a file from the input

Try this then:

Option Explicit
Sub Macro1()

    Dim objFSO As Object
    Dim varExtn As Variant, varExtns As Variant
    Dim strFileName As String
    Dim rngCell As Range
    Dim lngLastRow As Long, i As Long
    Dim ws As Worksheet
    
    Application.ScreenUpdating = True
    
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data. Change to suit if necessary.
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    lngLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    varExtns = ws.Range("B1:D1") 'Range of file extensions for each file to be checked against.
    
    For Each rngCell In ws.Range("A2:A" & lngLastRow)
        strFileName = Trim(objFSO.GetFileName(rngCell))
        For Each varExtn In varExtns
            i = i + 1
            'If the file name does not exist in the directory with any extension, then...
            If Dir("C:\Temp\" & CStr(varExtn) & "\" & strFileName & "*.*", vbDirectory) = "" Then
                '...flag the cell with the text 'Does Not Exist'
                rngCell.Offset(0, i).Value = "Does Not Exist"
            'Else...
            Else
                '...flag the cell with the text 'Does Exist'
                rngCell.Offset(0, i).Value = "Does Exist"
            End If
        Next varExtn
        i = 0
    Next rngCell
    
    Application.ScreenUpdating = False

End Sub

 

[nogarth]

spot on thanks that worked a dream. what i did change tho was this

strFileName = Trim(objFSO.GetBaseName(rngCell))

as i read BaseName auto drop the excention of the file. Thanks for the help i'll play more tonight with this