Gruppe
Datei
Bereich
Anwendung
Thema
Anwendung auf Fesplatte suchen
Problem
Eine in Zelle B1 stehende Anwendung soll auf dem aktiven Laufwerk gesucht werden.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const WAIT_TIMEOUT = &H102&
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Sub DOSShell()
Application.ScreenUpdating = False
On Error Resume Next
ChDrive "c"
ChDir "c:\"
On Error GoTo 0
ShellAndWait ("command.com /c dir/s/b " & _
Range("B1").Value & " >" & _
Application.DefaultFilePath & "\dirliste.txt")
Workbooks.Open Application.DefaultFilePath & "\dirliste.txt"
If IsEmpty(Range("A1")) Then
Beep
MsgBox "AcrobatReader wurde nicht gefunden!"
Else
MsgBox "Pfad: " & Range("A1").Value
End If
ActiveWorkbook.Close savechanges:=False
End Sub
Sub ShellAndWait(strEXE As String)
Dim ProcessID As Long
Dim hProcess As Long
Dim RetVal As Long
ProcessID = Shell(strEXE, vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
DoEvents
RetVal = WaitForSingleObject(hProcess, 50)
Loop Until RetVal <> WAIT_TIMEOUT
End Sub