Date and Time not showing

[Fathermole]

have this code but when it runs date and time do not Show

Sub list_save_times()

Dim myPath As String
Dim MyFile As String
Dim FldrPPicker As FileDialog
Dim sh As Worksheet
Dim i As Integer

Application.ScreenUpdating = False

Set sh = ThisWorkbook.Sheets("Last Save Times")
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Please Select Folder"
        .AllowMultiSelect = False
        .ButtonName = "Confirm!!!"
        If .Show = -1 Then
            myPath = .SelectedItems(1) & "\"
        Else
            End
        End If
    End With

sh.Activate
sh.Cells.ClearContents
Cells(1, 1) = "File Name(s)"
Cells(1, 2) = "Last Time Saved"
Cells(1, 4) = "Location:"
Cells(1, 5) = myPath
    
    
MyFile = Dir(myPath)
i = 1

Do While MyFile <> ""

    sh.Cells(i + 1, 1) = MyFile
    Workbooks.Open Filename:=myPath & MyFile
    With sh.Cells(i + 1, 2)
    .Value = ActiveWorkbook.BuiltinDocumentProperties(4)
    .NumberFormat = "mm-dd-yyyy h:mm AM/PM"

    
        End With
        ActiveWorkbook.Close savechanges:=False
        
    MyFile = Dir
    i = i + 1
Loop
sh.Range("A:B").Columns.AutoFit

If i = 1 Then
    
        
        MsgBox "There are no items in this folder"
         End If
        Application.ScreenUpdating = True
   
        
End Sub

 

[Fathermole]

This worked for me. Won't work on a Workbook that hasn't been saved yet (obviously)

d = ThisWorkbook.BuiltinDocumentProperties("Last Save Time")

This doesn't return proper last save time.

 

[Fathermole]

 

[Skyybot]

Try this:

Sub list_save_times()

Dim myPath As String
Dim MyFile As String
Dim FldrPPicker As FileDialog
Dim sh As Worksheet
Dim i As Integer
Dim wb  As Workbook

Application.ScreenUpdating = False

Set sh = ThisWorkbook.Sheets("Last Save Times")
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Please Select Folder"
        .AllowMultiSelect = False
        .ButtonName = "Confirm!!!"
        If .Show = -1 Then
            myPath = .SelectedItems(1) & "\"
        Else
            End
        End If
    End With

sh.Activate
sh.Cells.ClearContents
Cells(1, 1) = "File Name(s)"
Cells(1, 2) = "Last Time Saved"
Cells(1, 4) = "Location:"
Cells(1, 5) = myPath
    
    
MyFile = Dir(myPath)
i = 1

Do While MyFile <> ""

    sh.Cells(i + 1, 1) = MyFile
    Set wb = Workbooks.Open(Filename:=myPath & MyFile)
    With sh.Cells(i + 1, 2)
    .Value = wb.BuiltinDocumentProperties("Last Save Time")
    .NumberFormat = "mm-dd-yyyy h:mm AM/PM"

    
        End With
        wb.Close savechanges:=False
        
    MyFile = Dir
    i = i + 1
Loop
sh.Range("A:B").Columns.AutoFit

If i = 1 Then
    
        
        MsgBox "There are no items in this folder"
         End If
        Application.ScreenUpdating = True
   
        
End Sub

[CODE=vba]

[/CODE]