Check if files exist based on list of cell values-CodePudding

I need to check if a list of files exist in a certain directory, based on cell values in Excel. If some files are not found, a message box displays the names of the files that were not found.

CodePudding user response：

I'm unclear if you want to see the files listed in the range that do not appear in the folder or if you want to see the files in the folder that are not in the range.

The following example lists the files in the range that are not in the folder.

I've set up a page for the example, so you may need to adjust your sheet to match, or adjust your code to fit your sheet. Be sure that the folder path you put in B1 has the trailing backslash.

Here's the code:

Sub files_in_folder()
      
    Dim folder As String
    Dim filename As String
    Dim filenames As Range
    Dim cell As Range
    Dim s As Worksheet
    Dim missing As New Collection
    Dim message As String
    Dim x As Integer
    
    Set s = ActiveSheet
    folder = s.Range("b1").Value
    
    Set filenames = Range(s.Range("b2"), s.Range("b2").End(xlDown))
    
    For Each cell In filenames
        If Dir(folder   cell.Value) = "" Then missing.Add cell.Value
    Next
    
    If missing.Count = 0 Then
        message = "All files were found in " & folder
    Else
        message = "The following files were not found in " & folder & vbNewLine
        For x = 1 To missing.Count
            message = message   "   "   missing(x) & vbNewLine
        Next
    End If
    
    MsgBox message
  
End Sub

CodePudding user response：

Try this.

Sub TestListFilesInFolder()
    
' Open folder selection
' Open folder selection

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    pPath = .SelectedItems(1)
        If Right(pPath, 1) <> "\" Then
            pPath = pPath & "\"
        End If
End With


Application.WindowState = xlMinimized
Application.ScreenUpdating = False

    Workbooks.Add ' create a new workbook for the file list
    ' add headers
    ActiveSheet.Name = "ListOfFiles"
    With Range("A2")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "File Name:"
    Range("B3").Formula = "File Size:"
    Range("C3").Formula = "File Type:"
    Range("D3").Formula = "Date Created:"
    Range("E3").Formula = "Date Last Accessed:"
    Range("F3").Formula = "Date Last Modified:"
    Range("A3:F3").Font.Bold = True

    Worksheets("ListOfFiles").Range("A1").Value = pPath
    
        Range("A1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
        Selection.Font.Bold = True
    
    ListFilesInFolder Worksheets("ListOfFiles").Range("A1").Value, True
    ' list all files included subfolders

    Range("A3").Select
    
    Lastrow = Range("A1048576").End(xlUp).Row
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    ActiveWorkbook.Worksheets("ListOfFiles").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ListOfFiles").Sort.SortFields.Add Key:=Range( _
        "B4:B" & Lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ListOfFiles").Sort
        .SetRange Range("A3:F" & Lastrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    
Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 100
Range("A1").Select
   
NextCode:
MsgBox "No files Selected!!"

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A1048576").End(xlUp).Row   1
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(r, 1).Formula = FileItem.Path & FileItem.Name
        Cells(r, 2).Formula = (FileItem.Size / 1048576)
            Cells(r, 2).Value = Format(Cells(r, 2).Value, "##.##") & " MB"
        Cells(r, 3).Formula = FileItem.Type
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 5).Formula = FileItem.DateLastAccessed
        Cells(r, 6).Formula = FileItem.DateLastModified
        ' use file methods (not proper in this example)

        r = r   1 ' next row number
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns("A:F").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

Result: