Moin,

ich benutze eine programmierte Datei um Informationen aus mehreren Tagen (jeweils 1 Datei pro Tag und 4xArbeitsblätter pro Tag) zu einem Blatt zusammenzufuehren.

Allerdings ist meine Datei nur auf 32bit Version geschrieben und ich benoetige diese Datei als 64bit Version. Habe schon alle Declare fuctions auf PtrSafe geaendert und mit LongPtr rumgedoktert, aber staendig kommen Fehler mit "Compile error: type mismatch"

Für jegliche Hilfe wäre ich dankbar!

LG Eugen

Das ist der Code:

Option Explicit

Private Declare PtrSafe Function MoveWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal bRepaint As Long) As LongPtr
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32" ( _
    lpbi As InfoT) As LongPtr
Private Declare PtrSafe Function CoTaskMemFree Lib "ole32" ( _
    ByVal hMem As Long) As LongPtr
Private Declare PtrSafe Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
    ByVal lpStr1 As String, _
    ByVal lpStr2 As String) As LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" ( _
    ByVal pList As Long, _
    ByVal lpBuffer As String) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassname As String, _
    ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    wParam As Any, _
    lParam As Any) As LongPtr

Private Type InfoT
    hwnd As LongPtr
    Root As Long
    DisplayName As Long
    Title As Long
    Flags As Long
    FName As LongPtr
    lParam As LongPtr
    Image As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private s_BrowseInitDir As String
Private Function BrowseCallback( _
        ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As LongPtr
    If uMsg = &H1 Then
        Call SendMessage(hwnd, &H466, ByVal 1&, ByVal s_BrowseInitDir)
        Call CenterDialog(hwnd)
    End If
    BrowseCallback = 0
End Function

Private Function FuncCallback(ByVal nParam As Long) As Long
    FuncCallback = nParam
End Function

Private Sub CenterDialog(ByVal hwnd As Long)
    Dim WinRect As RECT, ScrWidth As Integer, ScrHeight As Integer
    Dim DlgWidth As Integer, DlgHeight As Integer
    GetWindowRect hwnd, WinRect
    DlgWidth = WinRect.Right - WinRect.Left
    DlgHeight = WinRect.Bottom - WinRect.Top
    ScrWidth = GetSystemMetrics(&H10)
    ScrHeight = GetSystemMetrics(&H11)
    MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
        (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Sub

Public Function fncGetFolder( _
        Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
        Optional ByVal sPath As String = "C:\") As String
    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
    
    If sPath Like "*.???" Or sPath Like "*.????" Then
     sPath = Left$(sPath, InStrRev(sPath, "\"))
    End If
   
    If Dir(sPath, vbDirectory) = "" Then
        sPath = ThisWorkbook.Path
    End If
    
    s_BrowseInitDir = sPath
    With xl
        .hwnd = FindWindow("XLMAIN", vbNullString)
        .Root = 0
        .Title = lstrcat(sMsg, "")
        .Flags = &H1
        .FName = FuncCallback(AddressOf BrowseCallback)
    End With
    IDList = SHBrowseForFolder(xl)
    If IDList <> 0 Then
        FolderName = Space(256)
        RVal = SHGetPathFromIDList(IDList, FolderName)
        CoTaskMemFree (IDList)
        FolderName = Trim$(FolderName)
        FolderName = Left$(FolderName, Len(FolderName) - 1)
    End If
    fncGetFolder = FolderName
End Function