獲取帶有MILLISECONDS的文件的最后修改日期？

Question

我正在嘗試從文件夾中獲取某些文件的日期和時間（最后修改）。 我設法獲得了日期和小時/分鍾/秒，但無法獲得毫秒 。

我已經嘗試過以所有可能的方式格式化列。 我只得到0毫秒。

到目前為止，我的代碼可以：

• 用戶選擇一個文件夾

• 代碼在A列中顯示找到的所有文件名，在B列中顯示日期，小時，分鍾和秒（最后修改的日期/時間）

我應該對當前代碼執行什么操作才能獲得毫秒數？

這是我的代碼：

Private Function GetAllFiles(ByVal strPath As String, _
    ByVal intRow As Integer, ByRef objFSO As Object) As Integer
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    i = intRow - ROW_FIRST + 1
    Set objFolder = objFSO.GetFolder(strPath)
    For Each objFile In objFolder.Files
        'print file name
        Cells(i + ROW_FIRST + 2, 1) = objFile.Name
        'print file path
        Cells(i + ROW_FIRST + 2, 2) = objFile.DateLastModified
        i = i + 1
    Next objFile
    GetAllFiles = i + ROW_FIRST - 1
End Function

Answer 1

以下模塊將使用Windows API調用來檢索Windows文件的創建，修改或訪問的日期時間（包括毫秒）。

但是，必須指出，存在許多潛在問題。 一個很大的問題是VBA Date數據類型的分辨率為1秒，因此datetime需要以String的形式返回，或以其他數據類型存儲（ Currency是正確的大小）。

Option Explicit

Declare Function GetFileTime Lib "kernel32.dll" (ByVal hFile As Long, _
    lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, _
    lpLastWriteTime As FILETIME) As Long

Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Declare Function FileTimeToSystemTime Lib "kernel32.dll" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type


Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_ALWAYS = 2
Const CREATE_NEW = 1
Const OPEN_ALWAYS = 4
Const OPEN_EXISTING = 3
Const TRUNCATE_EXISTING = 5
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Const FILE_FLAG_NO_BUFFERING = &H20000000
Const FILE_FLAG_OVERLAPPED = &H40000000
Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Const FILE_FLAG_WRITE_THROUGH = &H80000000

Function GetDateValue(fName As String) As String
'returns UTC (GMT) file time for specified file

    Dim hFile As Long ' handle to the opened file
    Dim ctime As FILETIME ' receives time of creation
    Dim atime As FILETIME ' receives time of last access
    Dim mtime As FILETIME ' receives time of last modification
    Dim Thetime As SYSTEMTIME ' used to manipulate the time
    Dim retval As Long ' return value

    hFile = CreateFile(fName, GENERIC_READ, FILE_SHARE_READ, _
        ByVal CLng(0), OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)

    retval = GetFileTime(hFile, ctime, atime, mtime)

    'Choose which date to return: creation, modify or access date
    'retval = FileTimeToSystemTime(ctime, Thetime) 'extract creation datetime
    retval = FileTimeToSystemTime(mtime, Thetime) 'extract modified datetime
    'retval = FileTimeToSystemTime(atime, Thetime) 'extract accessed datetime

    retval = CloseHandle(hFile)

    With Thetime
        GetDateValue = .wYear & Format(.wMonth, "\-00") & _
            Format(.wDay, "\-00") & " " & Format(.wHour, "00") & _
            Format(.wMinute, "\:00") & Format(.wSecond, "\:00") & _
            Format(.wSecond, "\.000")
    End With
End Function

Sub test()
    MsgBox GetDateValue("c:\logfile.txt") 
    'returns a string like "2018-03-31 16:13:52.052"
End Sub

我只是在這里粘貼它，雖然它不是完美的，但是它可以工作並且可以根據您的個人需求進行調整。 請注意，您需要手動取消注釋這 DATETIME你想要的功能，返回行。

在將其用於重要內容之前，請務必先閱讀本文檔，因為根據文件系統等的不同，會有一些限制。 例如，在您“認為”文件完成后，NTFS通常會完成寫操作……直到1小時后。

---

更多信息：

• VB Forumus： 代碼源 （請注意作者在隨后的文章中提到的錯誤。）

• MSDN： Windows文件時間

• MSDN： GetFileTime函數 （Windows / C ++）

• 堆棧溢出： 到目前為止，毫秒數的VBA字符串