Следующая подпроцедура (kernel32 была написана кем-то другим в StackOverflow) работает нормально и получает мне номер счета-фактуры для поиска номера заказа в указанном каталоге c, читая имена файлов в указанной папке и используя некоторые Текстовые функции VBA. Однако мне нужно кое-что понять, как использовать значение переменной с именем «ftCreationTime», определенной в процедуре «Закрытый тип WIN32_FIND_DATA», я как-то хочу использовать ее в своей подпрограмме FindFile.
Из-за сложности кодирование в модуле kernel32, мне нужна помощь, чтобы понять это.
Option Explicit
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Private Declare PtrSafe Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Declare PtrSafe Function FindNextFileW Lib "kernel32" (ByVal hFindFile As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Const MAX_PATH As Long = 260
Const ALTERNATE As Long = 14
' Can be used with either W or A functions
' Pass VarPtr(wfd) to W or simply wfd to A
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * ALTERNATE
End Type
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = 16 '0x10
Private Const INVALID_HANDLE_VALUE As LongPtr = -1
Sub FindFile()
Application.ScreenUpdating = True
Dim targetName As String
Dim targetPath As String
Dim RawFileName, InvoiceNumber As String
Dim cell As Range
Dim position As Integer
Dim FileName As String
Dim invoicetail As Integer
On Error Resume Next
For Each cell In Selection
If Len(cell) > 7 Then
targetName = Right(cell.value, 7)
Else
targetName = cell.value
End If
targetPath = "Y:\2020-Data\Invoices & Sales Tax Invoices\"
Dim target As String
target = Recurse(targetPath, targetName)
If Len(target) > 0 Then
position = Application.WorksheetFunction.Find("@", Application.WorksheetFunction.Substitute(target, "\", "@", (Len(target) - Len(Application.WorksheetFunction.Substitute(target, "\", ""))) / Len("\")))
cell.Font.Bold = False
cell.Font.Color = vbBlack
Else
position = 0
cell.Font.Bold = True
cell.Font.Color = vbRed
End If
FileName = Mid(target, position + 1, Len(target) - position)
invoicetail = Application.WorksheetFunction.Search("-", FileName) - 1
RawFileName = Mid(FileName, 1, invoicetail)
If Len(RawFileName) > 8 Then
InvoiceNumber = Right(RawFileName, 8)
Else
InvoiceNumber = RawFileName
End If
Range(cell.Address).Offset(0, 1) = InvoiceNumber
Range(cell.Address).Offset(0, 9) = Left(FileName, Len(FileName) - 4)
Next cell
End Sub
Function Recurse(folderPath As String, FileName As String)
Dim fileHandle As LongPtr
Dim searchPattern As String
Dim foundPath As String
Dim foundItem As String
Dim FileData As WIN32_FIND_DATA
searchPattern = folderPath & "\*"
foundPath = vbNullString
fileHandle = FindFirstFileW(StrPtr(searchPattern), VarPtr(FileData))
If fileHandle <> INVALID_HANDLE_VALUE Then
Do
foundItem = Left$(FileData.cFileName, InStr(FileData.cFileName, vbNullChar) - 1)
If foundItem = "." Or foundItem = ".." Then 'Skip metadirectories
'Found Directory
ElseIf FileData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
foundPath = Recurse(folderPath & "\" & foundItem, FileName)
'Found File
'ElseIf StrComp(foundItem, fileName, vbTextCompare) = 0 Then 'these seem about equal
ElseIf InStr(1, foundItem, FileName, vbTextCompare) > 0 Then 'for performance
foundPath = folderPath & "\" & foundItem
End If
If foundPath <> vbNullString Then
Recurse = foundPath
Exit Function
End If
Loop While FindNextFileW(fileHandle, VarPtr(FileData))
End If
'No Match Found
Recurse = vbNullString
End Function
Спасибо