Clever-Excel-Forum

Option Explicit

Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare PtrSafe Function GetOpenFileNameA Lib "comdlg32.dll" ( _
        pOpenfilename As OPENFILENAME) As Long

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

Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000&
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000


' Datei auswählen und öffnen
Function Waehle_Datei_API() As String
' Funktion zeigt einen DateiÖffen-Dialog mit erweiterten Features an.
  Dim sDatei As String, sPfad As String, sTitel As String, sErw As String
  Dim sFilter As String

  sFilter = "Herber*.x*"                   ' Dateifilter setzen
  sPfad = ThisWorkbook.Path
  sDatei = "MeineDatei.xlsm"
  If sDatei = "" Then sDatei = "*.*"
  sTitel = "Datei öffnen"
  sErw = ".xls*"

  If Trim(sPfad) = "" Then sPfad = CurDir
  If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"

  Dim OF As OPENFILENAME

  With OF
      .lStructSize = LenB(OF)    ' Achtung LenB ist wichtig
      .hwndOwner = GetActiveWindow()
      .lpstrTitle = sTitel & vbNullChar
      .lpstrFilter = "Meine Auswahl" & vbNullChar & sFilter & vbNullChar & vbNullChar
      .nFilterIndex = 0
      .flags = OFN_FILEMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_EXPLORER Or OFN_NOCHANGEDIR
      .lpstrFile = sDatei & Space(256) & vbNullChar
      .nMaxFile = Len(.lpstrFile)
      .lpstrFileTitle = Space(256) & vbNullChar
      .nMaxFileTitle = Len(.lpstrFileTitle)
      .lpstrInitialDir = sPfad & vbNullChar
      .lpstrDefExt = sErw
  End With
  If GetOpenFileNameA(OF) = 0 Then Exit Function
  sDatei = Left(OF.lpstrFile, InStr(OF.lpstrFile, Chr(0)) - 1)
  If Dir$(sDatei) <> "" Then
     MsgBox "Datei ausgewählt!"
  End If
End Function