Hi guys,
I've come up with the code that list out the folder name, file name with its details in the folder. Currently, I was wondering how could I get the newly added file in folder shows in the list by itself whenever user adds the file in that folder. I don't want to run the vba code everytime when the workbook is opens because there are more than 30k folders. Any help would be much appreciated. Please see below for the code and thanks in advanced.
I've come up with the code that list out the folder name, file name with its details in the folder. Currently, I was wondering how could I get the newly added file in folder shows in the list by itself whenever user adds the file in that folder. I don't want to run the vba code everytime when the workbook is opens because there are more than 30k folders. Any help would be much appreciated. Please see below for the code and thanks in advanced.
Code:
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