| 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 | |
| |
zurück