Как использовать переменную даты создания файла из подпрограммы Kernel в мою другую подпрограмму - PullRequest
0 голосов
/ 04 февраля 2020

Следующая подпроцедура (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

Спасибо

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...