Office: (Office 2010) Problem mit ShellExecute unter Win10

Game-Boy · 15. August 2015

Hallo,

ich nutze die Funktion 'ShellExecute' zum anzeigen von Bildern aus Access heraus. Hier der Code dazu:

Code:

Option Compare Database
Option Explicit

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 Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _
ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) As Long

Sub ShellExecFile(sFile As String)
Dim strFile As String, strTempPath As String, i As String
Dim strExe As String

On Error GoTo Fehler

strExe = GetFileExecutable(sFile)
If Len(strExe) > 0 Then
i = ShellExecute(Application.hWndAccessApp, "open", strExe, Chr$(34) & sFile & Chr$(34), CurrentProject.Path, 1)
Else
i = ShellExecute(Application.hWndAccessApp, "open", strExe, Chr$(34) & sFile & Chr$(34), CurrentProject.Path, 1)
End If
If i < 32 And i 0 Then
Dim sMsg As String
Select Case i
Case 2: sMsg = "Auszuführende Datei nicht gefunden"
Case 3: sMsg = "Pfad existiert nicht"
Case 5: sMsg = "Auf auszuführende Datei kann nicht zugegriffen werden"
Case 27: sMsg = "Keine Verknüpfung zu diesem Dateityp"
Case 31: sMsg = "Keine Verknüpfung zu diesem Dateityp"
Case Else
sMsg = "Unbekannter Fehler"
End Select
sMsg = "Fehler beim Versuch, die Datei anzuzeigen:" & vbCrLf & "'" & sMsg & "'"

MsgBox sMsg, vbOKOnly, "Dokument kann nicht geöffnet werden"

End If

Exit Sub

Fehler:
MsgBox Err.Description, vbCritical, "ShellExecFile"
End Sub

Function GetFileExecutable(sFile As String) As String
Dim ret As Long
Dim sExe As String

sExe = String(255, 0)
ret = FindExecutable(sFile, CurrentProject.Path, sExe)
If ret > 32 Then
GetFileExecutable = Left(sExe, InStr(1, sExe, Chr$(0)) - 1)
Else
Dim sError As String
Select Case ret
Case 2
sError = sFile & ": File not found"
Case 31
GetFileExecutable = ""
Case 8
sError = "Out of memory"
End Select
If Len(sError) > 0 Then Err.Raise vbObjectError, "GetFileExecutable", sError
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Unter Win 7 funktionierte das ohne Probleme.
Jetzt, unter Win 10 kam erst die Meldung 'Auszuführende Datei nicht gefunden'. Grund war, dass der 'Windows Photo Viewer' unter Win 10 nicht mehr aktiviert war.
Mit einem Tool konnte ich das beheben und die entsprechenden Dateien mit dem 'Windows Photo Viewer' verknüpfen.
Wenn ich im Explorer auf eine jpg-Datei klicke, wird sie im 'Windows Photo Viewer' geöffnet.
Wenn ich die Datei per 'ShellExecute' aus Access heraus öffnen will, kommt die Meldung 'Keine Verknüpfung zu diesem Dateityp'.

Hat jemand eine Tipp, woran das liegen kann?

Danke und Gruß

:)

gpswanderer · 17. August 2015

Hallo,
wenn Du statt Shell einfach mit FollowHyperlink arbeitest geht das auch automatisch.

Code:

FollowHyperlink PfadUndDateiname
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es ist keine Hyperlinkfeld, das ist ein normales Textfeld.

Game-Boy · 17. August 2015

Das geht auch.
Kannte ich noch nicht.
Hab es gerade mal mit Videos probiert. Da funktioniert auch, aber es kommt immer vorher eine Warnung, dass Viren enthalten sein könnten.
Kann man diese Warnung abstellen?

Danke für den Tipp.

gpswanderer · 17. August 2015

Hallo,
kann man abstellen, weis aber nicht wie. Ich habe nur Access2003 und da kommt die Warnung nicht. Musst mal warten, möglicherweise weiß es jemand anders.

fraeser · 17. August 2015

Kommt die Warnung von Access, von Windows oder einem Antivirenprogramm?

Game-Boy · 17. August 2015

Die Meldung kommt von Access bzw. Office.

wb_3001 · 17. August 2015

Hallo Game-Boy!

Hast Du schon Folgendes probiert?

Dim shl As Object
Set shl = CreateObject("Shell.Application")
shl.ShellExecute strDeineTextDatei, , , "open", 1
Set shl = Nothing
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wolfgang

Game-Boy · 18. August 2015

Das funktioniert super, ohne Warnfenster.

Danke.

Office: (Office 2010) Problem mit ShellExecute unter Win10

Problem mit ShellExecute unter Win10

Problem mit ShellExecute unter Win10

Problem mit ShellExecute unter Win10

Problem mit ShellExecute unter Win10

Problem mit ShellExecute unter Win10 - Similar Threads - Problem ShellExecute Win10

Outlook Problem

Problem bei Fußnote

Excel found a problem with one or more formula references in this worksheet

Zählenwenns Problem

Problem mit Seitenzahlen/Seitenbeschriftung

Data Transform, Problem with delimiter

Problem Datenstruktur Mitglieds-Datenbank