new added file to the folder in vba
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
Re: new added file to the folder in vba
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