How to update files info [File listed in range with full path]

[loveguy1977]

Dear,
Below is a VBA that will list all files in the folder that this excel is saved in & with hyperlink. Notice that this VBA is fast to list all files.

Column B is File Full Path

Column D is Size
Column E is Date Created
Column F is Date Last Accessed
Column G is Date Last Modified

My question here, how can I update info in columns D, E, F & G based on the file listed in column B using different VBA.

I'm in needed for that please

Thank you very much


Option Explicit
Public FirstTimeListingSubFolders As Boolean
Public ListSubFolders As VbMsgBoxResult
Public ListAllDetails As VbMsgBoxResult
Public fs As Object, F As Object
Sub ListFilesAndFolders()
Dim RequestedDirectory, ThisFolder As String
Dim n As Long
Dim ConvertToHyperlinks As VbMsgBoxResult
Application.ScreenUpdating = False
Cells(1, 1) = "Folder"
Cells(1, 2) = "File Location"
Cells(1, 3) = "File Name"
Cells(1, 4) = "Size"
Cells(1, 5) = "Date Created"
Cells(1, 6) = "Date Last Accessed"
Cells(1, 7) = "Date Last Modified"
ThisFolder = ThisWorkbook.Path & "\"

Call GetSubDirectories(ThisFolder, ListSubFolders)

For n = 2 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(n, 1)
.Value = "=hyperlink(" & Chr(34) & .Value & Chr(34) & ", " & Chr(34) & .Value & Chr(34) & ")"
With .Offset(0, 1)
.Value = "=hyperlink(" & Chr(34) & .Value & Chr(34) & ", " & Chr(34) & .Value & Chr(34) & ")"
End With
End With
Next n

Columns.AutoFit
Application.ScreenUpdating = True
Set fs = Nothing
Set F = Nothing
End Sub
Sub GetSubDirectories(folderspec, ListSubFolders As VbMsgBoxResult)
Application.ScreenUpdating = False
Dim SubFolder
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(folderspec)
Call GetFiles(F.Path, ListAllDetails)

For Each SubFolder In F.SubFolders
Call GetSubDirectories(SubFolder.Path, ListSubFolders) 'This is a recursive call
Next SubFolder
End Sub
Sub GetFiles(folderspec, ListAllDetails As VbMsgBoxResult)
Dim r As Long
Dim file
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(folderspec)
For Each file In F.Files
On Error Resume Next
r = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(r, 1) = folderspec
Cells(r, 2) = folderspec & "\" & file.Name
Cells(r, 3) = file.Name
Cells(r, 4) = file.Size
Cells(r, 5) = file.DateCreated
Cells(r, 6) = file.DateLastAccessed
Cells(r, 7) = file.DateLastModified
On Error GoTo 0
Application.ScreenUpdating = False
Next file
Application.ScreenUpdating = False
End Sub

[Kenneth Hobs]

That code is odd in that it only worked once.

Sub RefreshFileInfo()
Dim r As Range, file As Object
Set fs = CreateObject("Scripting.FileSystemObject")
For Each r In Range("B2", Range("B" & Rows.Count).End(xlUp))
With r
If fs.FileExists(.Value2) Then
Set file = fs.GetFile(.Value2)
Cells(.Row, 4) = file.Size
Cells(.Row, 5) = file.DateCreated
Cells(.Row, 6) = file.DateLastAccessed
Cells(.Row, 7) = file.DateLastModified
End If
End With
Next r
End Sub

[loveguy1977]

Thank you very much
It is great