troubleshooting Question

Update VBA macro from 32 bit to 64 bit

Avatar of trekrok
trekrok asked on
3 Comments1 Solution3311 ViewsLast Modified:
My knowledge of this code is minimal.

The Declare statements need updated with PtrSafe along with the 'pointer/handles' changed to LongPtr, I think. I don't understand what  a pointer or handle is, so I'm confused as to where I need to make this change. I don't believe I should change all the 'Long' to 'LongPtr', so how can I determine which need updated and which do not? As always, any help is appreciated.

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

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 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.
        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
        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
Join our community to see this answer!
Unlock 1 Answer and 3 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 3 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros