Option Explicit
 
'SHELL32
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
 
 
Private Const SW_SHOW As Long = 5           ' normal öffnen
Private Const SW_SHOWMAXIMIZED As Long = 3  ' maximiert öffnen
 
Private Const SE_ERR_SYSRESSOURCES = 0
Private Const ERROR_BAD_FORMAT = 17
Private Const SE_ERR_ACCESSDENIED = 5
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_OOM = 8
Private Const SE_ERR_PNF = 3
Private Const SE_ERR_SHARE = 26
Private Const SE_NOERRORTEXT = 32
 
Private Sub Form_Load()
Dim z As String
z = App.Path
If OpenFile(z & "\Data-2005.xls") = False Then
    MsgBox "Die Datei Data-2005 konnte nicht geöffnet werden !", vbExclamation
End
End If
End Sub
 
' Öffnet eine Datei wie aus dem Explorer
'
Public Function OpenFile(ByVal FileName As String, _
  Optional ByVal Maximized As Boolean = True, _
  Optional ByVal ShowError As Boolean = True) As Boolean
  On Error Resume Next
 
  Dim lReturn As Long, sError As String, sPath As String, sFileName As String
  Dim P As Long
 
  ' letzten "\" entfernen, außer wenn an 3. Stelle (bsw. bei C:\)
  P = InStrRev(FileName, "\")
  If P = 3 Then P = P - 1
  sPath = Left(FileName, P)
 
  ' "open" - entsprichten dem Explorer-Menübefehl Datei\Öffnen (nur wenn von 
  ' Dateityp unterstützt)
  ' "edit" - entsprichten dem Explorer-Menübefehl Datei\Bearbeiten (nur wenn 
  ' von Dateityp unterstützt)
  ' ...
  lReturn = ShellExecute(Me.hwnd, "open", FileName, vbNullChar, sPath, _
    IIf(Not Maximized, SW_SHOW, SW_SHOWMAXIMIZED))
 
  ' Rückgabewert von ShellExecute ggf. in Fehlertext umwandeln
  sError = ShellExecuteError(lReturn)
 
  ' Fehlertext verfügbar? --> dann als Fehlermeldung zeigen
  If sError <> "" Then
    ' Sollen Fehler ausgegeben werden
    If ShowError Then MsgBox sError & vbNewLine & FileName, vbExclamation
  End If
 
End Function
 
' Prüft, ob ein Rückgabewert von ShellExcute ein Fehler war
'
Private Function ShellExecuteError(ByVal lReturn As Long) As String
  On Error Resume Next
 
  ' Kein Fehler? --> Na dann zurück
  If lReturn > SE_NOERRORTEXT Then Exit Function
 
  ' Fehler-Rückgabewerte von Shellexecute
  Select Case lReturn
    Case SE_ERR_SYSRESSOURCES:    ShellExecuteError = "Nicht genügend" & _
      "Systemressourcen zum Ausführung der Funktion."
    Case ERROR_BAD_FORMAT:        ShellExecuteError = "Die Datei ist keine" & _
    "Win32-Anwendung."
    Case SE_ERR_ACCESSDENIED:     ShellExecuteError = "Zugriff verweigert."
    Case SE_ERR_ASSOCINCOMPLETE:  ShellExecuteError = "Die Datei-Assoziation" & _
      "ist unvollständig."
    Case SE_ERR_DDEBUSY:          ShellExecuteError = "DDE ist nicht bereit."
    Case SE_ERR_DDEFAIL:          ShellExecuteError = "Der DDE-Vorgang" & _
      "gescheitert."
    Case SE_ERR_DDETIMEOUT:       ShellExecuteError = "Das DDE-Zeitlimit wurde" & _
    "erreicht."
    Case SE_ERR_DLLNOTFOUND:      ShellExecuteError = "Eine benötigte DLL wurde" & _
    "nicht gefunden."
    Case SE_ERR_FNF:              ShellExecuteError = "Die Datei wurde nicht" & _
    "gefunden."
    Case SE_ERR_NOASSOC:          ShellExecuteError = "Die Datei ist nicht" & _
    "assoziiert."
    Case SE_ERR_OOM:              ShellExecuteError = "Nicht genügend Speicher."
    Case SE_ERR_PNF:              ShellExecuteError = "Der Pfad wurde nicht" & _
      "gefunden."
    Case SE_ERR_SHARE:            ShellExecuteError = "Sharing-Verletzung"
    Case Else:                    ShellExecuteError = "Die Datei konnte nicht" & _
      "geöffnet werden."
  End Select
 
End Function