Locate Files of Predefined Extension, in Predefined Location & List in Spreadsheet

Hi All,

I require a bit of code that locates where the excel file is stored - it then searches that directory folder for all file names. Any file names with an extension *.hm for example are listed in column A, while their relevant 'Dates of last Modification' are listed in Column B.

Every time the spreadsheet opens it should ask the user if he/she requires a re-search of this directory and update of any file names accordingly.

NB: if a file name is deleted from the directory, the file name should remain in the spreadsheet.

I don't know if the above can be done - but I welcome your suggestions and example files if you can.

Cheers

Hello R_S_6,

Place this macro in the your Workbook_Open() event module. When the workbook opens it will ask you if you want to update the file list. Only new files will be added to the list. The list is set for "Sheet2" starting in cell A2. You will need to change the folder and the file extension variables as well in the macro. These are all marked in red. Make these changes before you save the macro. This code works with Excel 2000 and up.

Sub UpdateFileList()
  
  Dim Answer As Variant
  Dim C As Long
  Dim DSO As Object
  Dim Ext As String
  Dim FolderName As String
  Dim FSO As Object
  Dim LastRow As Long
  Dim MyFile As Object
  Dim MyFiles As Object
  Dim R As Long
  Dim Rng As Range
  Dim StartCell
  Dim Wks As Worksheet
      
    Answer = MsgBox("Do you want to update the file list?", vbInformation + vbYesNo)
      If Answer = vbNo Then Exit Sub
      
        Ext = "xls"
        FolderName = "C:\Documents and Settings\Owner\My Documents"
        StartCell = "A2"
        
        Set Wks = Worksheets("Sheet2")
          With Wks
            C = .Range(StartCell).Column
            R = .Range(StartCell).Row
            LastRow = .Cells(Rows.Count, C).End(xlUp).Row
            LastRow = IIf(LastRow < R, R, LastRow)
            Set Rng = .Range(.Cells(R, C), .Cells(LastRow, C))
          End With
          
          Set DSO = CreateObject("Scripting.Dictionary")
            DSO.CompareMode = 1   'TextCompare
              For R = 1 To Rng.Rows.Count
                With Rng.Cells(R, 1)
                  If .Value <> "" Then DSO.Add .Text, "saved"
                End With
              Next R
            
          Set FSO = CreateObject("Scripting.FileSystemObject")
          Set MyFiles = FSO.GetFolder(FolderName).Files
          If LastRow <> Rng.Row Then R = LastRow + 1
              
            For Each MyFile In MyFiles
              If FSO.GetExtensionName(MyFile) = Ext Then
                If Not DSO.Exists(MyFile.Name) = True Then
                  Wks.Cells(R, C) = MyFile.Name
                  Wks.Cells(R, C + 1) = MyFile.DateLastModified
                  R = R + 1
                End If
              End If
            Next MyFile
            
      Set DSO = Nothing
      Set FSO = Nothing
      
End Sub

How to Save a Workbook Event Macro
1. Copy the macro using CTRL+C keys.
2. Open your Workbook and Right Click on any Worksheet's Name Tab
3. Left Click on View Code in the pop up menu.
4. Press ALT+F11 keys to open the Visual Basic Editor.
5. Press CTRL+R keys to shift the focus to the Project Explorer Window
6. Press the Down Arrow Key until ThisWorkbook is highlighted in blue.
7. Press the Enter key to move the cursor to the Code Window
8. Paste the macro code using CTRL+V
9. Save the macro in your Workbook using CTRL+S

Sincerely,
Leith Ross