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.
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




Reply With Quote
