Kein öffnen
22.10.2007 14:12:38
Kurt
Hey NoNet,
habe so in ein Modul gesetzt, leider keine Reaktion:
'Koproduktion zwichen Zugvogel und NoNet, ca. 2005 oder 2006
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
'SystemRoot%\explorer.exe /e,c:\
'Explorer.exe
'Rückgabekonstanten:
Const ERROR_BAD_FORMAT = 11& ' Datei ist keine Win32 Anwendung
Const SE_ERR_ACCESSDENIED = 5 ' Zugriff verweigert
Const SE_ERR_ASSOCINCOMPLETE = 27 ' Datei-Assoziation ist unvollständig
Const SE_ERR_DDEBUSY = 30 ' DDE ist nicht bereit
Const SE_ERR_DDEFAIL = 29 ' DDE-Vorgang gescheitert
Const SE_ERR_DDETIMEOUT = 28 ' DDE-Zeitlimit wurde erreicht
Const SE_ERR_DLLNOTFOUND = 32 ' benötigte DLL wurde nicht gefunden
Const SE_ERR_FNF = 2 ' Datei wurde nicht gefunden
Const SE_ERR_NOASSOC = 31 ' Datei ist nicht Assoziiert
Const SE_ERR_OOM = 8 ' Nicht genügend Speicher
Const SE_ERR_PNF = 3 ' Pfad wurde nicht gefunden
Const SE_ERR_SHARE = 26 ' Sharing-Verletzung
Const SE_ERR_RESOURCE = 0 'Zuwenig Systemresourcen stehen zur Verfügung
Sub DateiStarten()
'Sucht in einem vorgegebenen Verzeichnis nach bestimmten Dateien und öffnet/druckt diese
Dim retVal As Long
Dim i_Datei
With Application.FileSearch
.Filename = "*.*" 'Alle *.DOC-Dateien suchen
.LookIn = "C:\1_PKW_Verkauf" 'In diesem Ordner suchen
.SearchSubFolders = False 'ohne Unterordner. Falls doch : = TRUE
.Execute
For i_Datei = 1 To .FoundFiles.Count
'retVal = DateiStarten(.FoundFiles(i_Datei), , "Print")
Select Case retVal
Case SE_ERR_NOASSOC
MsgBox "Datei ist mit keiner Anwendung assoziiert :" & vbLf & _
.FoundFiles(i_Datei), vbInformation, "Fehler"
Case SE_ERR_PNF
MsgBox "Pfad wurde nicht gefunden : " & vbLf & _
.LookIn, vbInformation, "Fehler"
i_Datei = .FoundFiles.Count
Case SE_ERR_FNF
MsgBox "Datei wurde nicht gefunden : " & vbLf & _
.FoundFiles(i_Datei), vbInformation, "Fehler"
Case 8, 26, 32, 28, 29, 30, 27, 5, 11 ' alle anderen Fehler
'nix
End Select
Next i_Datei
End With
End Sub
Function DateiStarten(fullPath As String, Optional ByVal WindowStyle As VbAppWinStyle = _
vbNormalFocus, _
Optional ByVal Operation As String = "open") As Long
DateiStarten = (ShellExecute(0&, Operation, fullPath, _
vbNullString, vbNullString, WindowStyle) > 32)
End Function
gr Kurt P