AW: Probleme mit VBA auf Rechner mit 64-Bit-Excel
28.12.2024 17:09:51
volti
Hallo Joschi,
vorab: Ich kenne die Funktionen nicht und sie stehen auch nicht in meinem (sehr umfangreichen) API-Viewer.
Ich haben mich aber nach gesunden Menschenverstand an die Umsetzung gemacht und bei mir läuft es fehlerfrei und wie gewünscht durch.
Denke ich zumindest, da ich nicht genau weiß, was damit bezweckt wird und ich Deinen Code auch nicht umfänglich analysiert habe. Anzahl irgendwelcher Files ermitteln?!
Ich habe 64-Bit Excel.
Probiere es einfach mal aus.
Umsetzungshinweise:
Für 32/64-Bit-Excel VBA7 muss bei jeder API-Funktionsdeklaration das Schlüsselwort PtrSafe ergänzt werden. Eine sicher einfache Übung, wären da nicht noch ein paar Datentypen, vor allem Handles und Pointer zu berücksichtigen. Diese sind unter reinem 64-Bit vom Typ Longlong, wir verwenden hier aber die Mischform LongPtr.
Für Strings gibt es zwei Varianten der Deklaration: AS STRING mit Übergabe per String oder LongPtr mit Übergabe per StrPtr.
Diese müssen in den Declares aber auch im Code entsprechend berücksichtigt werden, sonst kann es schon mal zum Absturz kommen....
Code:
Option Explicit
Option Compare Text
Private Declare PtrSafe Function EnumDirTreeW Lib "Dbghelp.dll" (ByVal hProcess As LongPtr, _
ByVal RootPath As LongPtr, ByVal InputPathName As LongPtr, _
ByVal OutputPathBuffer As LongPtr, ByVal cb As LongPtr, ByVal data As LongPtr) As Long
Private Declare PtrSafe Function lstrlenW Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function lstrcpyW Lib "kernel32.dll" ( _
ByVal lpString1 As LongPtr, ByVal lpString2 As String) As Long
Public ApiFMask As String
Function ApiFileList(ByVal PathList As String, _
Optional APIMask As String = "*") As Variant
Dim ApiFColl As Collection
Dim ApiFPLoop As Integer
Dim ApiFVCount As Long
Dim ApiFVLoop As Long
Dim ApiFTVal As Single
Dim ApiFNPath As String
Dim ApiFCVar As Variant
Dim ApiFPVar As Variant
ApiFMask = APIMask
Set ApiFColl = New Collection
ApiFTVal = Timer
ApiFPVar = Split(PathList, ";")
For ApiFPLoop = 0 To UBound(ApiFPVar)
ApiFNPath = ApiFPVar(ApiFPLoop)
If Right(ApiFNPath, 1) <> "\" Then ApiFNPath = ApiFNPath & "\"
EnumDirTreeW 0, StrPtr(ApiFNPath), StrPtr("*"), 0, AddressOf CallBackEnumDirTree, ObjPtr(ApiFColl)
Next ApiFPLoop
ApiFVCount = ApiFColl.Count
If ApiFVCount = 0 Then
ReDim ApiFCVar(0)
ApiFCVar(0) = 0
GoTo FuncExit
End If
ReDim ApiFCVar(1 To ApiFVCount)
' Debug.Print "Enum: " & Format(Timer - APIFTVal, "#0.000000") & " Sekunden für " & APIFVCount & " Files"
For ApiFVLoop = 1 To ApiFVCount
ApiFCVar(ApiFVLoop) = ApiFColl(ApiFVLoop)
Next ApiFVLoop
' Debug.Print "Enum: " & Format(Timer - APIFTVal, "#0.000000") & " Sekunden das Kopieren in einen Array"
FuncExit:
ApiFileList = ApiFCVar
End Function
Function CallBackEnumDirTree(ByVal lpcwstr As LongPtr, ByVal CBColl As Object) As Boolean
Const ApiFCbeRecyle As String = ":\$RECYCLE.BIN\"
Dim ApiFCbeEPos As Integer
Dim ApiFCbeFPos As Integer
Dim ApiFCbeFExt As String
Dim ApiFCbeFFnm As String
ApiFCbeFFnm = String(lstrlenW(lpcwstr), 0)
lstrcpyW StrPtr(ApiFCbeFFnm), lpcwstr
ApiFCbeEPos = InStrRev(ApiFCbeFFnm, ".")
ApiFCbeFPos = InStrRev(ApiFCbeFFnm, "\")
ApiFCbeFExt = Mid(ApiFCbeFFnm, ApiFCbeEPos + 1)
If Mid(ApiFCbeFFnm, 2, Len(ApiFCbeRecyle)) = ApiFCbeRecyle Then Exit Function
If ApiFCbeFExt Like ApiFMask Then CBColl.Add Item:=ApiFCbeFFnm
End Function
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
