Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ShellExecute Funktion lässt Excel zusammenbrechen

ShellExecute Funktion lässt Excel zusammenbrechen
14.05.2014 15:22:16
Hagen
Hi Leute,
Folgendes Problem:
Ich habe ein Modul geschrieben mit dem aus einer Steuertabelle anhand einer Bezeichnung ein Dateipfad ausgelesen werden soll und die Datei geöffnet werden. Dafür erschien mir die ShellExecute Funktion am besten, da ich damit die verschiedensten Dateitypen öffnen kann ohne konkrete Kenntnisse vom System zu haben. Dies funktioniert auch für jeden Dateityp, abgesehen von jeglichen Excel Dateien. Nach dem alles regulär ausgeführt wird hängt sich Excel Bei dem ShellExecute Command auf und reagiert teilweise noch, aber lässt sich z.B. nicht mehr schließen und öffnet auch keine weiter Excel-Datei.
Hier ist der Quellcode:

Option Explicit
'*    ShellExecute Initalization     *
Public 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
Public Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpclassname As Any, _
ByVal lpCaption As Any) As Long
Public Const SW_HIDE = 0
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_NORMAL = 1
Public Const SW_SHOW = 5
Public Const SW_RESTORE = 9
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1
Public Const ERROR_BAD_FORMAT = 11&
Public Const SE_ERR_ACCESSDENIED = 5
Public Const SE_ERR_ASSOCINCOMPLETE = 27
Public Const SE_ERR_DDEBUSY = 30
Public Const SE_ERR_DDEFAIL = 29
Public Const SE_ERR_DDETIMEOUT = 28
Public Const SE_ERR_DLLNOTFOUND = 32
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Const SE_ERR_OOM = 8
Public Const SE_ERR_PNF = 3
Public Const SE_ERR_SHARE = 26
Public Const ControlWks As String = "Directory"
Public Const NameRange As String = "A1:A10000"
Public Const LocationRange As String = "B"
'*    FileOpen Function     *
Public Function FileOpen(ByVal Location As String) As Boolean
Dim ReturnValue As Long
Dim hWnd As Long
hWnd = apiFindWindow("OPUSAPP", "0")
ReturnValue = ShellExecute(hWnd, "open", Location, "", "C:\", SW_SHOW)
Select Case ReturnValue
Case ERROR_BAD_FORMAT
MsgBox "Datei ist keine Win32 Anwendung.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_ACCESSDENIED
MsgBox "Zugriff verweigert.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_ASSOCINCOMPLETE
MsgBox "Datei-Assoziation ist unvollständig.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_DDEBUSY
MsgBox "DDE ist nicht bereit.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_DDEFAIL
MsgBox "DDE-Vorgang gescheitert.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_DDETIMEOUT
MsgBox "DDE-Zeitlimit wurde erreicht.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_DLLNOTFOUND
MsgBox "benötigte DLL wurde nicht gefunden.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_FNF
MsgBox "Datei wurde nicht gefunden.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_NOASSOC
MsgBox "Datei ist nicht Assoziiert.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_OOM
MsgBox "Nicht genügend Speicher.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_PNF
MsgBox "Pfad wurde nicht gefunden.", vbInformation, "Fehler"
FileOpen = False
Case SE_ERR_SHARE
MsgBox "Sharing-Verletzung.", vbInformation, "Fehler"
FileOpen = False
Case Else
FileOpen = True
End Select
End Function
'*    NewEntry Function     *
Public Function NewEntry() As String
Dim ReturnMsg As Long
ReturnMsg = MsgBox("Eintrag nicht gefunden. Neuer Eintrag?", vbYesNoCancel, "Neuer Eintrag")
Select Case ReturnMsg
Case 2
NewEntry = "0"
Case 6
NewEntry = LocationInput("")
Case 7
NewEntry = "0"
Case Else
NewEntry = "0"
End Select
End Function
'*    LocationInput Function     *
Public Function LocationInput(Location As String)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Dateipfad"
.ButtonName = "Auswählen"
If Location  "" Then
.InitialFileName = Location
Else
.InitialFileName = "file:\\"
End If
If .Show = -1 Then
LocationInput = .SelectedItems(1)
Else
End
End If
End With
End Function
'*    GetLocation Function     *
Public Function GetLocation(Name As String) As String
Dim RowNum As Long
Dim LastRow As Long
Dim NameEntries() As Variant
NameEntries = Worksheets(ControlWks).Range(NameRange).Value
On Error GoTo NotFound
RowNum = WorksheetFunction.Match(Name, NameEntries, False)
GetLocation = Worksheets(ControlWks).Range(LocationRange & RowNum).Value
Exit Function
NotFound:
Dim Location As String
Location = NewEntry()
If Location  "0" Then
LastRow = Worksheets(ControlWks).Range("A10000").End(xlUp).Row + 1
Worksheets(ControlWks).Range("A" & LastRow).Value = Name
Worksheets(ControlWks).Range("B" & LastRow).Value = Location
GetLocation = GetLocation(Name)
Else
End
End If
End Function
'*    Execute Sub     *
Sub Execute(Name As String)
Dim ReturnValue As Boolean
Dim Location As String
Name = "Versuch"
Location = GetLocation(Name)
ReturnValue = FileOpen(Location)
End Sub

Was mach ich hier falsch?
Gruß Hagen

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
ShellExecute Funktion lässt Excel zusammenbrechen
15.05.2014 08:36:16
Nepumuk
Hallo,
das sich Excelmappen so nicht öffnen lassen, liegt daran, dass das Ganze in Excel läuft. Aus Word heraus würde das öffnen von Excelmappen per ShellExecute klappen. Du musst also eine neue Excelinstanz erstellen und darin die Mappe öffnen, oder, wenn du die Mappe in der selben Application öffnen willst, dann einfach mit Workbooks.Open
Wenn du verschiedene Dateien öffnen willst, dann kannst du sie ja an der Endung unterscheiden.
Übrigens: hWnd = apiFindWindow("OPUSAPP", "0")
OPUSAPP ist der Klassenname des Word-Fensters und der 2. Parameter der FindWindow-Funktion erwartet entweder die Caption des Fensters oder einen Leerstring (vbNullString).
Den 1. Parameter der ShellExecute-Funktion kannst du auch auf 0 setzen, denn es gibt in dem Fall keine Bindung der geöffneten Datei an die Datei in der sich der Code befindet. Der Parameter dient dazu: Wenn du eine .exe mit der Funktion startest, kannst damit du das Parent-Window angeben und die gestartete .exe kann z.B. Nachrichten an das Parent-Window senden da es eindeutig identifizierbar ist.
Gruß
Nepumuk

Anzeige
AW: ShellExecute Funktion lässt Excel zusammenbrechen
15.05.2014 20:31:56
Hagen
Hi Nepumuk,
Also die Sache mit OPUSAPP habe ich rein gemacht, nachdem ich auf einer Microsoft Seite das ganze so für das öffnen von Excel Dateien gesehen habe, habe das auch probiert mit XLMAIN anstatt OPUSAPP. Ok, meinst du jetzt im Grunde, dass ich überprüfe ob es sich um eine Excel Datei handelt und dann entsprechend eine neue Instanz öffnen, hast du dafür zufälligerweise einen Code wo rumfahren, beziehungsweise gibt es eine einfache Prüffunktion auf Excel Dateien?
Gruß Hagen

ShellExecute Funktion lässt Excel zusammenbrechen
16.05.2014 10:08:07
Nepumuk
Hallo,
eine Möglichkeit:
Public Sub Test()
    
    Dim strPath As String
    Dim avntTemp As Variant
    
    strPath = "D:\Eigene Dateien\Eigene Tabellen\Datei.xlsx"
    
    avntTemp = Split(strPath, ".")
    
    If LCase$(avntTemp(UBound(avntTemp))) Like "xls*" Then
        MsgBox "Excelmappe"
    Else
        MsgBox "Andere Datei"
    End If
End Sub

Gruß
Nepumuk
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige