new added file to the folder in vba

[klpw]

Hi all,

I've created vba code which shows the folder name, file name with its details. I was thinking whenever there is newly added file in the folder, how can I make the details being updated in the xlsm file automatically when open next time without user key in the data in excel sheet or run the vba code again by themselve? Please see below for the code.

Thanks in advanced.

Option Explicit
Private Sub Auto_Open()
Dim Cell As Range
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
'Dim i As Integer
Dim fil As Object
Dim sf As Object
Dim col As Integer
Dim rw As Integer
'Dim Number As Integer
Rows("2:" & Range("B" & Rows.Count).End(xlUp).Row + 1).Clear
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\maggie\Desktop\low")
Range("A1") = "Folder Name"
Range("B1") = "File Name"
Range("C1") = "Revision Time"
Range("D1") = "Date Updated"
Range("E1") = "Revision Time"
Range("F1") = "Date Updated"
Range("G1") = "Revision Time"
Range("H1") = "Date Updated"
Range("I1") = "Revision Time"
Range("J1") = "Date Updated"
Range("K1") = "Revision Time"
Range("L1") = "Date Updated"
Range("M1") = "Revision Time"
Range("N1") = "Date Updated"
Range("O1") = "Revision Time"
Range("P1") = "Date Updated"
Range("Q1") = "Revision Time"
Range("R1") = "Date Updated"
Range("S1") = "Revision Time"
Range("T1") = "Date Updated"
Range("U1") = "Revision Time"
Range("V1") = "Date Updated"
'Format(Range("D3"), "d-m-yyyy").
rw = 1
'loops through each folder in the directory and prints their names and path
'On Error GoTo handleCancel
'Application.EnableCancelKey = xlErrorHandler
'MsgBox "This may take a long time: press ESC to cancel"
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder name
    Cells(rw + 1, 1) = objFolder.Name
    'print file name
    Cells(rw + 1, 2) = Left(objSubFolder.Name, 8)
    'col = 4
    'Cells(rw + 1, col).Value = objSubFolder.DateLastModified
    'col = col + 2
    col = 3
            For Each fil In objSubFolder.Files
                If fil.Name <> "Thumbs.db" Then
                If Mid(fil.Name, 9, 1) = "R" And Mid(fil.Name, 10, 1) <= 100 Then
                    Cells(rw + 1, col) = Mid(fil.Name, 10, InStrRev(fil.Name, ".") - 10)
                    Cells(rw + 1, col + 1) = fil.DateLastModified
                    Else
                    Cells(rw + 1, col) = "error"
                    Cells(rw + 1, col + 1) = fil.DateLastModified
               End If
                col = col + 2
                End If
            Next fil
            rw = rw + 1
            Next objSubFolder
handleCancel:
If Err = 18 Then
 MsgBox "You cancelled"
End If
End Sub

Sub Test_Folder_Exist_With_Dir()
If ActiveCell.Column = 2 And ActiveCell.Row > 1 Then


Dim FSO
Dim sFolder As String
Dim sPath As String

sFolder = "C:\Users\maggie\Desktop\low" ' You can Specify Any Folder To Check It
sPath = sFolder & "\" & ActiveCell.Value
Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(sFolder) Then
Call Shell("explorer.exe " & sPath, vbNormalFocus)
Else
MsgBox "Specified Folder Not Found", vbInformation, "Folder Not Found!"
End If
End If
End Sub

[westconn1]

this code only gets the files from the subfolders of C:\Users\maggie\Desktop\low, it does not get files from subfolders of the subfolders, and does not get the files from the first folder

to update the list automatically you could use a timer that loops all the folders again and just adds files that are not already listed
or you can use monitor folder APIs (or scripting) with callback whenever a new file is added to the folder, it can be added to the list
if you need to monitor multiple folders it may become a bit complex