Update VBA macro from 32 bit to 64 bit

Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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 * 14
End Type


Private mcolFiles As Collection
Private mlngFileCount As Long

Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Variant, DirCount As Variant)
   
    Dim strFile As String ' Walking strFile variable...
    Dim strDirName As String ' SubDirectory Name
    Dim strDirNames() As String ' Buffer for directory name entries
    Dim intDir As Integer ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim intCont As Integer
    If Right(path, 1) <> "\" Then path = path & "\"
    ' Search for subdirectories.
    intDir = 0
    ReDim strDirNames(intDir)
    intCont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While intCont
        strDirName = StripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (strDirName <> ".") And (strDirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetFileAttributes(path & strDirName) And FILE_ATTRIBUTE_DIRECTORY Then
                strDirNames(intDir) = strDirName
                DirCount = DirCount + 1
                intDir = intDir + 1
                ReDim Preserve strDirNames(intDir)
            End If
        End If
        intCont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
        Loop
        intCont = FindClose(hSearch)
    End If
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    intCont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While intCont
            strFile = StripNulls(WFD.cFileName)
            If (strFile <> ".") And (strFile <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + CDbl(1)
                mlngFileCount = mlngFileCount + 1
                mcolFiles.Add path & strFile
            End If
            intCont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        intCont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If intDir > 0 Then
        ' Recursively walk into them...
        For i = 0 To intDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & strDirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
End Function

Public Function fGetFilesRecurse(strPath As String, strPattern As String, dblTotalSize As Double) As Collection
    Dim dblFileCount As Double
    Dim dblDirCount As Double
   
   
    Set mcolFiles = New Collection
    dblTotalSize = FindFilesAPI(strPath, strPattern, dblFileCount, dblDirCount)
   
    Set fGetFilesRecurse = mcolFiles
    Set mcolFiles = Nothing

End Function

Public Function fNumFiles() As Long
    fNumFiles = mlngFileCount
End Function
End Function



End Function

End Sub

Select allOpen in new window