List files in a folder with Microsoft Scripting Runtime using VBA in Microsoft Ex

Hi there

I used the below script which is fabulous tip on your forum, I have set up about 20 document registers to run on different folders for contracts. however the problem that I have is the when you run an update on the register once it opens, it recreates the lists that are already captured, I need it to just capture the new information when it comes into the folders. I thought it was doing this however I was incorrect. any help would be appreciated - some of these registers have 1 to 2 thousand files in them, so updating them again and again takes time and not to mention too much information to sort through

Sub TestListFilesInFolder()
      With Range("A1")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "Doc Number:"
    Range("B3").Formula = "Direction:"
    Range("C3").Formula = "File Type:"
    Range("D3").Formula = "Date Created:"
    Range("E3").Formula = "TO:"
    Range("F3").Formula = "FROM:"
    Range("G3").Formula = "Notes:"
    Range("H3").Formula = "Short File Name:"
    Range("I3").Formula = "Hyperlink:"
    Range("J3").Formula = "Full Document Path:"
    Range("A3:J3").Font.Bold = True
    ListFilesInFolder "G:\CFS\Administration\Contracts\Project 2020\CTR-530148 - Howdens Vent fan installation", True
    ' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
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("J65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        ' display file properties
      
        Cells(r, 3).Formula = FileItem.Type
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 8).Formula = FileItem.Name
        Cells(r, 10).Formula = FileItem.path
        ' use file methods (not proper in this example)
'        FileItem.Copy "C:\FolderName\Filename.txt", True
'        FileItem.Move "C:\FolderName\Filename.txt"
'        FileItem.Delete True
        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:H").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

Hi there

Sorry, i'm not a coder or expert - hope this helps

I used the below script which is fabulous tip on your forum, I have set up about 20 document registers to run on different folders for contracts. however the problem that I have is the when you run an update on the register once it opens, it recreates the lists that are already captured, I need it to just capture the new information when it comes into the folders. I thought it was doing this however I was incorrect. any help would be appreciated - some of these registers have 1 to 2 thousand files in them, so updating them again and again takes time and not to mention too much information to sort through

Sub TestListFilesInFolder()
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "Doc Number:"
Range("B3").Formula = "Direction:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "TO:"
Range("F3").Formula = "FROM:"
Range("G3").Formula = "Notes:"
Range("H3").Formula = "Short File Name:"
Range("I3").Formula = "Hyperlink:"
Range("J3").Formula = "Full Document Path:"
Range("A3:J3").Font.Bold = True
ListFilesInFolder "G:\CFS\Administration\Contracts\Project 2020\CTR-530148 - Howdens Vent fan installation", True
' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
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("J65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties

Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 8).Formula = FileItem.Name
Cells(r, 10).Formula = FileItem.path
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
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:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub