Anwendungen schließen und mit Visual Basic neu öffnen

Internet-Browser im Minutentakt schließen und neu öffnen

Anwendungen schließen und mit Visual Basic neu öffnen via GetWindow, GetClassName, FindWindow, FindExecutable
Bei Klick auf einen Link wird jedesmal ein neues Fenster des Internet-Explorers oder z.B. eine neue Session des
Acrobat Reader geöffnet. Dieser Code veranlasst, dass die offene Anwendung zuerst geschlossen wird, bevor
das neue Fenster geöffnet wird. An die Function wird nur die Window-Klasse (hier: WinClass) übergeben.
Der im Internet kursierende Tipp mit "Windows-Name auslesen" funktioniert nur, wenn der User seine
Fenster nicht individuell umbenannt hat.
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Const WM_CLOSE = &H10
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Public Function EndTask(WindowKlasse As String) As Integer
Dim lngWindow As Long, lngWindowLast As Long, i As Integer
Dim strClass As String, strTitle As String
Dim hwnd As Long
hwnd = FindWindow(ByVal 0&, ByVal 0&)
hwnd = GetWindow(hwnd, GW_HWNDFIRST)
lngWindow = GetWindow(hwnd, GW_HWNDFIRST)
lngWindowLast = GetWindow(hwnd, GW_HWNDLAST)
Do While lngWindow <> lngWindowLast Loop über alle Fenster.
strClass = Space(100) Puffer für KlassenNamen und Fenstertitel.
strTitle = Space(100)
DoEvents
GetWindowText lngWindow, strTitle, 100 KlassenNamen und FensterTitel ermitteln.
GetClassName lngWindow, strClass, 100
If InStr(strClass, WindowKlasse) <> 0 Then
PostMessage lngWindow, WM_CLOSE, 0&, 0& Nachricht ans Fenster senden um es zu schließen.
DoEvents
lngWindow = GetWindow(hwnd, GW_HWNDFIRST)
Exit Function Wenn erstes Fenster gefunden dann Exit.
Else
lngWindow = GetWindow(lngWindow, GW_HWNDNEXT) Nächstes Fenster finden.
DoEvents
End If
Loop
End Function
   
Sub Command1_Click() Anwendung schließen und dann öffnen.
Dim DateiNam$, WinClass$, ApplPath$
WinClass = "Acrobat" Internet-Explorer: WinClass = "IEFrame".
Call EndTask(WinClass) Window-Klasse an die Function übergeben.
Call Suche_Anwendung(ApplPath, DateiNam) Beliebige Anwendung suchen.
DateiNam = """" & ApplPath & """" & " " & """" & DateiName & """" Pfad wird zusammengestellt.
Shell DateiNam, vbMaximizedFocus Beliebige Datei wird geöffnet (z.B. Flash, Bilder,
Musik, Videos oder Texte...)
' Call Word_Start(DateiNam) Oder nur Word starten (siehe unten).
' Call Inet_Start(DateiNam) Oder nur Internet Explorer starten (siehe unten).
' Call PPStart(DateiNam) Oder nur Powerpoint starten (siehe unten).
' Call ExcelStart(FileNam) Oder nur Excel starten (siehe unten).
End Sub
   
Ab hier Funktionen, wie man Programme öffnet...
Mit API FindExecutable das dazugehörige Programm holen
Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" (ByVal lpFile As String, _
ByVal lpDirectory As String, ByVal lpResult As String) As Long
Function Suche_Anwendung(Applic, FileNam) Beliebige Anwendung öffnen.
Dim strExe As String, new_strExe As String, i%
strExe = Space(260)
FindExecutable FileNam, "", strExe In strExe steht die Anwendung (wird über die API aus
dem Betriebssystem ermittelt.
If strExe <> "" Then Wenn strExe leer ist, ist kein Programm zugeordnet.
For i = 1 To Len(strExe) String muss noch geschnitten werden (hinter .exe
new_strExe = new_strExe & Mid(strExe, i, 1) steht Datenmüll).
If LCase(Right(new_strExe, 4)) = ".exe" Then
Applic = new_strExe Die Anwendung wird zurückgegeben.
Exit For
End If
Next i
End If
End Function
Function Word_Start(FileNam) Word öffnen.
Dim wrdApp As Object, wrdDoc As Object
If Not FileNam = "" Then
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(FileNam)
wrdApp.Visible = True
Set wrdDoc = Nothing
Set wrdApp = Nothing
End If
End Function
Function Inet_Start(FileNam) Internet Explorer öffnen.
Dim IEApp As Object
On Error Resume Next
If Not FileNam = "" Then
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
.Navigate FileNam Öffnet IE mit übergebenem Dateinamen.
.Visible = True Sichtbar ja oder nein.
.Resizable = True Fenstergröße veränderbar.
.Left = 110 Position zum linken Bildschirmrand.
.Top = 15 Position zum oberen Bildschirmrand.
.Width = 900 Fensterbreite.
.Height = 600 Fensterhöhe.
End With
Set IEApp = Nothing
End If
End Function
Function PPStart(FileNam) Powerpoint öffnen.
Dim pptApp As New PowerPoint.Application
Dim pptDoc As PowerPoint.Presentation
If Not FileNam = "" Then
If pptApp Is Nothing Then
Set pptApp = GetObject(, "Powerpoint.Application")
End If
Set pptDoc = pptApp.Presentations.Open(FileNam, False, False, False)
' Set pptDoc = pptApp.Presentations.Add(msoCTrue) Erzeugt neue Powerpoint-Präsentation.
pptApp.Visible = True
Set pptDoc = Nothing
Set pptApp = Nothing
End If
End Function
Function ExcelStart(FileNam)
If Not FileNam = "" Then
Set xAppl = New Excel.Application
xAppl.Workbooks.Open (DName)
xAppl.Visible = True
Set xAppl = Nothing
End If
End Function
   
Weitere Anwendungen öffnen:
Notepad
Shell "notepad.exe " & DateiName, vbNormalFocus
WinAmp
Dim WinAmp$
WinAmp = "C:\Programme\Winamp\winamp.exe"
If Dir(WinAmp) <> "" Then
Nur eine Datei abspielen
DateiName = """" & WinAmp & """" & " " & """" & DateiName & """"
Neue Dateien hinzufügen
' DateiName = """" & WinAmp & """" & " /ADD" & " " & """" & DateiName & """"
Shell DateiName, vbNormalFocus
' Shell(DateiName, 1)
End If
   
Internet-Browser im Minutentakt schließen und wieder neu öffnen (diese Anwendung verwende ich zum Testen der
DSL-Verbindung - z. B. bei der Neueinrichtung eines Routers):
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Const WM_CLOSE = &H10
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Sub Form_Load() Formular laden.
Timer1.Enabled = True Timer einschalten.
Timer1.Interval = 1000 Timer läuft im Sekundentakt.
Call Browser_Start Funktion öffnet Internet Explorer.
End Sub
Sub Timer1_Timer() Der Timer wird bei Formularstart eingeschaltet:
DoEvents
Select Case Format(Time, "ss")
Case "00" Im Sekundentakt wird nun geprüft, ob eine Minute
Call Browser_Start verstrichen ist; wenn ja wird eine Funktion
Case Else ausgelöst, die eine Webseite aufruft.
'''
End Select
End Sub
Function Browser_Start()
Dim IEApp As Object
On Error Resume Next
Call EndTask("IEFrame") Das alte Browser-Fenster wird geschlossen.
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Navigate "http://www.wbrnet.info/" Öffnet eine neue Session des Internet Explorers.
IEApp.Visible = True Internet Explorer wird sichtbar gemacht.
Set IEApp = Nothing
End Function
Function EndTask(WindowKlasse As String) As Integer Diese Funktion beendet die "alte" Session des
Dim lngWindow As Long, lngWindowLast As Long, i As Integer Internet Explorers.
Dim strClass As String, strTitle As String
Dim hwnd As Long
hwnd = FindWindow(ByVal 0&, ByVal 0&)
hwnd = GetWindow(hwnd, GW_HWNDFIRST)
lngWindow = GetWindow(hwnd, GW_HWNDFIRST)
lngWindowLast = GetWindow(hwnd, GW_HWNDLAST)
Do While lngWindow <> lngWindowLast Loop über alle Fenster.
strClass = Space(100) Puffer für KlassenNamen und Fenstertitel.
strTitle = Space(100)
DoEvents
GetWindowText lngWindow, strTitle, 100 KlassenNamen und FensterTitel ermitteln.
GetClassName lngWindow, strClass, 100
If InStr(strClass, WindowKlasse) <> 0 Then
PostMessage lngWindow, WM_CLOSE, 0&, 0& Nachricht ans Fenster senden um es zu schließen.
DoEvents
lngWindow = GetWindow(hwnd, GW_HWNDFIRST)
Exit Function Wenn erstes Fenster gefunden dann Exit.
Else
lngWindow = GetWindow(lngWindow, GW_HWNDNEXT) Nächstes Fenster finden.
DoEvents
End If
Loop
End Function
Sub cmdStop_Click() Button auf Formular: Programm beenden.
Timer1.Enabled = False Timer deaktivieren.
Unload Me Formular entladen.
End Sub

Mehr Tipps: index.dat lesen & LogFile schreiben

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt