我正在尝试从文件夹中获取某些文件的日期和时间(上次修改)。我设法获得了日期和小时/分钟/秒,但我无法获得 毫秒 。
我已经尝试过尽可能地格式化列。我只得到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
答案 0 :(得分:3)
以下模块将使用Windows API调用检索Windows文件创建,修改或访问日期时间,包括毫秒。
但必须注意的是,存在许多潜在问题。一个重要的是VBA Date
数据类型的分辨率为1秒,因此日期时间需要作为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
我只是在这里粘贴它,它并不完美,但它可以工作,可以根据您的个人需求进行调整。请注意,您需要手动取消注释的行您想要函数返回的日期时间。
在使用此功能之前,请务必先阅读相关内容,因为根据文件系统的不同,存在一些限制。例如,NTFS通常会在你" think"之后写完一个文件。它已经完成......最多1小时后。
VB论坛:Code Source(请注意作者在以下帖子中提到的错误。)
MSDN:Windows File Times
MSDN:GetFileTime Function(Windows / C ++)
Stack Overflow:VBA String with Milliseconds to Date