Check if files exist from list in Column A in folder/subfolders and return "True"

[jimjones1958]

Hello,

I am attempting to have an Excel VBScript to return the file path and also "True" if files exist in a folder and or subfolders based on file names in column A.

Here is an example of the file structure:

J0wbl.png


I've started the code but I've gotten a little lost. Any help will be greatly appreciated!

Here is the code I have so far:

Please Login or Register  to view this content.

[grimes0332]

Where have you 'got lost'?. It works fine, after you add a couple of lines to update the worksheet and perhaps increment the counter used for the message box at the end...

[jimjones1958]

Hello,

How do you compare if the file name is found?

[Marc L]

A VBA basics demonstration for starters to paste to the top of a module (better the worksheet module) :

Dim M$(), N& 
 
Function DirList(SCAN$, Optional FOLD$, Optional ATTR As VbFileAttribute = vbNormal) As String() 
         Dim B%, D$, F$, T$(), U& 
    With Application 
        If FOLD > "" Then 
            If Right(FOLD, 1) <> .PathSeparator And Left(SCAN, 1) <> .PathSeparator Then FOLD = FOLD & .PathSeparator 
            D = FOLD 
        Else 
            D = Left$(SCAN, InStrRev(SCAN, .PathSeparator)) 
        End If 
    End With 
        If SCAN = "." Then SCAN = "*." 
        On Error Resume Next 
        F = Dir$(FOLD & SCAN, ATTR) 
    Do Until F = "" 
        If ATTR And vbDirectory Then B = Right(F, 1) = "." Or (GetAttr(D & F) And vbDirectory) = 0 
        If B = 0 Then U = U + 1: ReDim Preserve T(1 To U): T(U) = FOLD & F 
        F = Dir$ 
    Loop 
         DirList = IIf(U, T, Split("")) 
End Function 
 
Sub DirScan(WHAT$, ByVal FROM$) 
    Dim S$(), L&, V 
        S = DirList(WHAT, FROM) 
        If UBound(S) > 0 Then ReDim Preserve M(1 To N + UBound(S)): For L = 1 To UBound(S): N = N + 1: M(N) = S(L): Next 
        For Each V In DirList("*", FROM, vbDirectory):  DirScan WHAT, V:  Next 
End Sub 
 
Sub Demo1() 
         Dim A, V, W 
         ReDim M(1 To 1) 
         N = 0 
    With Range("A2", [A1].End(xlDown)).Columns 
        .Item("B:C").ClearContents 
    With Application.FileDialog(4) 
        If .Show Then DirScan "*", .SelectedItems(1) Else Exit Sub 
    End With 
         A = .Item(1).Value2 
         V = .Item("B:C").Value2 
    With Application 
        For N = 1 To UBound(A) 
            W = .Match("*" & .PathSeparator & A(N, 1), M, 0) 
            V(N, 1) = IsNumeric(W) 
            If V(N, 1) Then V(N, 2) = Left(M(W), InStrRev(M(W), .PathSeparator)) 
        Next 
    End With 
        .Item("B:C") = V 
        .Item(3).AutoFit 
    End With 
End Sub  

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄