Dialog (API) mit Anfangspfad zur Dateiauswahl

Weitaus mehr Möglichkeiten als der abgespeckte Excel-Dialog

Beispieldatei WinDialog.zip 16 kB

Private Declare Function GetOpenFileName Lib _
  "comdlg32.dll" Alias "GetOpenFileNameA" _
  (pOpenfilename As OPENFILENAME) As Long

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_WRITE = &H2

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

Public Function GetFileOpen(StartDir As String, _
  Optional Extension As String, Optional Titel As String)
Dim udtOF As OPENFILENAME
Dim lngRück As Long, a As String
  a = Extension
  With udtOF
    .lStructSize = Len(udtOF)
    .lpstrFile = String(255, 0)
    .nMaxFile = 255
    .lpstrFileTitle = String(255, 0)
    .nMaxFileTitle = 255
    'Dialogtitel
    .lpstrTitle = Titel
    'Suchfilter
    If a <> "" Then
      'Wenn Extension übergeben wurde,
      'dann den Filter setzen
      .lpstrFilter = UCase(a) & _
        " - Dateien (*." & a & ")" _
        & Chr$(0) & "*." & a & "" _
        & Chr$(0)
    End If
    'Dateifilter auf alle Dateien
    .lpstrFilter = .lpstrFilter & _
      "Alle Dateien (*.*)" _
      & Chr$(0) & "*.*" & Chr$(0)
    'Startverzeichnis setzen
    If Right$(StartDir, 1) <> "\" Then _
      StartDir = StartDir & "\"
    .lpstrInitialDir = StartDir
    lngRück = GetOpenFileName(udtOF)
    If lngRück = 0 Then Exit Function
    GetFileOpen = Left$(.lpstrFile, _
      InStr(1, .lpstrFile, Chr(0)) - 1)
  End With
End Function