Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Anwendung auf Fesplatte suchen

Gruppe

Anwendung

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