File Dialog Box mit Access 64 Bit

August 2025

Wenn ihr eure Access-Anwendung auf Office 64 Bit umstellt, werdet ihr feststellen, dass die File Dialog Box sich nicht damit begnügt, dass in der Deklaration ein "PtrSafe" eingefügt wird. Hier muss auch der Typ der Variablen, die an die Funktion übergeben wird, ein bisschen angepasst werden:

#If VBA7 Then
  Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
  End Type
#Else
  Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
  End Type
#End If

Die Unterscheidung nach VBA7 brauchen wir dabei nur, wenn die Anwendung auch weiterhin unter Access 32 Bit laufen soll - ansonsten brauchen wir nur den ersten Fall.

Die Deklaration der API-Funktionen sieht dann folgendermaßen aus (man beachte den Typ "Boolean" der Rückgabe):

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Bei mir geht es dann folgendermaßen weiter:

Public Function FileOpen(Optional Title, Optional InitDir, Optional FileName, Optional DefExt, Optional Filter, Optional FilterIdx, Optional Flags) As Variant
  FileOpen = FileDialog("Open", Title, InitDir, FileName, DefExt, Filter, FilterIdx, Flags)
End Function

Public Function FileSave(Optional Title, Optional InitDir, Optional FileName, Optional DefExt, Optional Filter, Optional FilterIdx, Optional Flags) As Variant
  FileSave = FileDialog("Saver", Title, InitDir, FileName, DefExt, Filter, FilterIdx, Flags)
End Function

 
Public Function FileDialog(Modus As String, Optional Title, Optional InitDir, Optional FileName, Optional DefExt, Optional Filter, Optional FilterIdx, Optional Flags) As Variant
' zeigt Dialogbox zur Auswahl eines Dateinamens
' Filter zB. "Word-Dateien(*.docx)" & vbNullChar & "*.docx"
' FilterIdx = welcher Filter beim Öffnen gesetzt sein soll, startet bei 0
' DefExt zB. "docx" (Default-Extension, wenn Name ohne Extension eingegeben wird)

Dim ofn As OPENFILENAME
Dim FileNameStr As String
Dim Result As Boolean
Dim Pos As Integer
Dim Msg As String, Code As String, Info As Variant, Status As Integer

    On Error Goto Err_

    If Not IsMissing(FileName) Then
      FileNameStr = FileName & String$(250, vbNullChar)
    Else
      FileNameStr = String$(250, vbNullChar)
    End If

    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = Application.hWndAccessApp
    If Not IsMissing(Filter) Then
      ofn.lpstrFilter = Filter & vbNullChar
    End If
    ofn.lpstrFile = FileNameStr
    ofn.nMaxFile = Len(FileNameStr)
    If Not IsMissing(Title) Then
      ofn.lpstrTitle = Title & vbNullChar
    End If
    If Not IsMissing(InitDir) Then
      ofn.lpstrInitialDir = InitDir & vbNullChar
    End If
    If Not IsMissing(DefExt) Then
      ofn.lpstrDefExt = DefExt & vbNullChar
    End If
    If Not IsMissing(FilterIdx) Then
      ofn.nFilterIndex = FilterIdx
    Else
      ofn.nFilterIndex = 1
    End If
    If Not IsMissing(Flags) Then
      ofn.Flags = Flags
    Else
      ofn.Flags = 0
    End If
    
    If Modus = "Open" Then
      Result = GetOpenFileName(ofn)
    Else
      Result = GetSaveFileName(ofn)
    End If
    
    If Not Result Then
      FileDialog = Null
    Else
      Pos = InStr(ofn.lpstrFile, vbNullChar)
      If Pos > 0 Then
        FileDialog = Left$(ofn.lpstrFile, Pos - 1)
      Else
        FileDialog = Null
      End If
    End If

    Exit Function

Err_:
  Msgbox = "Fehler beim Ermitteln des Dateinamens"
  FileDialog = Null
  Exit Function

End Function

Falls ihr noch allgemeinere Infos zum Upgrade auf Access 64 Bit braucht, findet ihr sie in unserem Artikel "Access-Datenbanken auf 64 Bit Office umstellen".

Kommentare (0)

Keine Kommentare gefunden!

Neuen Kommentar schreiben