updated file in folder for vba

[klpw]

Hi guys,

I've created vba code for the listing of folder name and file name with its details. I was thinking if the user upload a new file into the folder, how can I make the information for this new file being available in the xlsm file automatically without prompting user to put the information into the xlsm file manually or run the vba code again. I don't want to run the workbook itself when the user opens the file because there are more than 30k files in the folder, so it takes very long time to run. I just want the file being added into the excel list whenever new file is being added into that folder. 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

 

[Marc L]

Duplicate thread so closed !
​