We help IT Professionals succeed at work.
Get Started

Update VBA macro from 32 bit to 64 bit

trekrok asked
Last Modified: 2016-08-21
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

Open in new window

Watch Question
Top Expert 2016
This problem has been solved!
Unlock 1 Answer and 3 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE