Doppelte Webseite öffnen verhindern

01.12.2024 08:28:26

sigiF

Wie kann ich verhindern das eine bereits geöffnete Webseite nochmals geöffnet wird?
Meine Makro läuft endlos,
Danke! Gruß Sigi
Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As Any, ByRef ppvObject As Any) As Long
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Sub ABC_Seite()
Dim edgePath As String
Dim adresse As String
Dim hwnd As Long
Dim hwndChild As Long
Dim className As String * 256
Dim url As String
Dim gefunden As Boolean
gefunden = False
adresse = "https://auskunft.abc.de" ' URL der Webseite

hwnd = FindWindowEx(0, 0, "Chrome_WidgetWin_1", vbNullString)
Do While hwnd > 0
Debug.Print "Starte die Schleife"
hwndChild = FindWindowEx(hwnd, 0, "Chrome_RenderWidgetHostHWND", vbNullString)
If hwndChild > 0 Then
Debug.Print "Aktuelles hwnd: " & hwnd
' Hier den URL des Tabs abrufen
url = GetTabURL(hwndChild)
If InStr(url, adresse) > 0 Then
gefunden = True
hwnd = 0 ' Setze hwnd auf 0, um die Schleife zu beenden
Exit Do
End If
End If
hwnd = FindWindowEx(0, 0, "Chrome_WidgetWin_1", vbNullString) ' Parent-Fenster auf 0 setzen
Loop
Debug.Print "Schleife beendet " & gefunden
If gefunden = False Then
edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
Shell edgePath & " """ & adresse & """", vbNormalFocus
End If
End Sub

' Funktion zum Abrufen des URL des aktuellen Tabs
Private Function GetTabURL(ByVal hwndChild As Long) As String
Debug.Print GetTabURL
GetTabURL = "https://auskunft.abc.de" ' Hier den richtigen URL einfügen
End Function

AW: Doppelte Webseite öffnen verhindern

01.12.2024 10:38:49

Oberschlumpf

Hi,

bei mir funktioniert es so:

Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As Any, ByRef ppvObject As Any) As Long
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Sub ABC_Seite()
Dim edgePath As String
Dim adresse As String
Dim hwnd As Long
Dim hwndChild As Long
Dim className As String * 256
Dim url As String
Dim gefunden As Boolean
gefunden = False
adresse = "https://herber.de" ' URL der Webseite

hwnd = FindWindowEx(0, 0, "Chrome_WidgetWin_1", vbNullString)
Do While hwnd > 0
Debug.Print "Starte die Schleife"
hwndChild = FindWindowEx(hwnd, 0, "Chrome_RenderWidgetHostHWND", vbNullString)
If hwndChild > 0 Then
Debug.Print "Aktuelles hwnd: " & hwnd
' Hier den URL des Tabs abrufen
url = GetTabURL(hwndChild, adresse)
If InStr(url, adresse) > 0 Then
gefunden = True
hwnd = 0 ' Setze hwnd auf 0, um die Schleife zu beenden
Exit Do
End If
End If
hwnd = FindWindowEx(0, 0, "Chrome_WidgetWin_1", vbNullString) ' Parent-Fenster auf 0 setzen
Loop
Debug.Print "Schleife beendet " & gefunden
If gefunden = False Then
edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
Shell edgePath & " """ & adresse & """", vbNormalFocus
End If
End Sub

' Funktion zum Abrufen des URL des aktuellen Tabs
Private Function GetTabURL(ByVal hwndChild As Long, ByVal urladr As String) As String
Debug.Print GetTabURL
GetTabURL = urladr ' Hier den richtigen URL einfügen
End Function

Ach ja, wenn wir das Code-Format hier nutzen würden, dann könnte die Code-Darstellung so..und damit übersichtlicher aussehen, oder?



Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As Any, ByRef ppvObject As Any) As Long

Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Sub ABC_Seite()

Dim edgePath As String

Dim adresse As String

Dim hwnd As Long

Dim hwndChild As Long

Dim className As String * 256

Dim url As String

Dim gefunden As Boolean

gefunden = False

adresse = "https://herber.de" ' URL der Webseite

'...usw

End Sub

Konnte ich helfen?

Ciao
Thorsten

AW: Doppelte Webseite öffnen verhindern

01.12.2024 10:56:56

volti

Hallo Sigi,

zunächst einmal: Deine Declares sind falsch, wo hast Du die her? Handle müssen als LongPtr declariert werden, siehe hierzu auch im API-Viewer.
https://www.clever-excel-forum.de/Thread-API-Viewer.

Dann, lass die Do-Schleife weg. FindWindow findet immer wieder nur das erste passende Fenster. Da wird die Schleife nie verlassen.

Aber vielleicht wäre es auch eine gute Idee, das Vorhandensein der Web-Seite nicht mit FindWindow sondern mit EnumWindows und ggf. EnumChildWindows zu machen.
EnumWindows geht alle Fenster durch. Da kann man sich dann das passende rausfischen und entsprechend reagieren. Evtl. auch schon doppelt geöffnete Fenster mit SendMessage wieder schließen

Ein Beispiel als Ansatz hierzu:
https://www.clever-excel-forum.de/Thread-Finden-von-Fenstern-Handle-Ermittlung

Und eine (nicht getestete) Anpassung Deines Codes:
Und wozu benötigst Du AccessibleObjectFromWindow und GetClassname?

Code:


Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
        ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
        ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare PtrSafe Sub AccessibleObjectFromWindow Lib "oleacc.dll" ( _
        ByVal hwnd As LongPtr, ByVal dwId As Long, _
        ByRef riid As GUID, ByRef ppvObject As Any)

Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Sub ABC_Seite()
 Dim edgePath  As String
 Dim adresse   As String
 Dim hwnd      As LongPtr
 Dim hwndChild As LongPtr
 Dim url       As String
 Dim gefunden  As Boolean
 
 adresse = "https://auskunft.abc.de" color=#00a000> ' URL der Webseite

 hwnd = FindWindowEx(0, 0, "Chrome_WidgetWin_1", vbNullString)
 If hwnd <> 0 Then
    hwndChild = FindWindowEx(hwnd, 0, "Chrome_RenderWidgetHostHWND", vbNullString)
    If hwndChild <> 0 Then
' Hier den URL des Tabs abrufen
       url = GetTabURL(hwndChild)
       If InStr(url, adresse) > 0 Then gefunden = True
    End If
 End If


If gefunden = False Then
    edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
    Shell edgePath & " """ & adresse & """", vbNormalFocus
End If
End Sub

' Funktion zum Abrufen des URL des aktuellen Tabs
Private Function GetTabURL(ByVal hwndChild As LongPtr) As String
  Debug.Print GetTabURL
  GetTabURL = "https://auskunft.abc.de" color=#00a000> ' Hier den richtigen URL einfügen
End Function

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Doppelte Webseite öffnen verhindern

01.12.2024 11:03:51

volti

Hallo,

eine Korrigierung:

FindwindowEx kann doch mit Schleife durchsuchen. Also vergiss meinen Codevorschlag und passe ggf. nur die Declares an.

Gruß
Karl-Heinz

AW: Doppelte Webseite öffnen verhindern

01.12.2024 11:43:42

sigiF

Hallo Karl Heinz,
Danke für Deinen Hinweis!
Im Enderfolg will ich nur verhindern das eine Website doppelt geöffnet wird.
Leider öffnet Dein Makro die Webseite nochmals.
Du hast Recht, die Declare sind umsonst.
Da es so nicht funktioniert habe ich mir gedacht, das ich es über die PostMessage versuche
Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub AVV_Seite()
Dim edgePath As String
Dim adresse As String
Dim hwnd As Long
Dim gefunden As Boolean
gefunden = False
adresse = "https://auskunft.avv.de" ' URL der Webseite

' Überprüfen, ob das Fenster bereits geöffnet ist
hwnd = FindWindow(vbNullString, "Fahrplan - AVV Aachen - Fahrplanauskunft")
If hwnd = 0 Then
' Versuchen, das Fenster über einen Teil des Titels zu finden
hwnd = FindWindow(vbNullString, "Fahrplan - AVV")
gefunden = True
End If
'Seite wurde gefunden
If hwnd > 0 Then
gefunden = True
ShowWindow hwnd, SW_RESTORE
SetForegroundWindow hwnd
AppActivate "Fahrplan - AVV Aachen - Fahrplanauskunft"
Else
' Neue Instanz von Edge öffnen
edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
Shell edgePath & " """ & adresse & """", vbNormalFocus
End If
End Sub
Leider wird die Seite nicht in den Vordergrund gebracht.

Danke für Deine Hilfe!
Gruß
Sigi

AW: Doppelte Webseite öffnen verhindern

01.12.2024 12:31:57

volti

Hallo Sigi,

dass mein Codevorschlag nicht funktioniert, ist klar. Ich habe mit FindWindowEx noch nicht viel gemacht.

Ich habe zwischenzeitlich auch ein wenig rumgespielt. Das Thema ist nicht einfach.

In Deiner Schleife wir immer das gleiche Childhandle gefunden und die Childklasse ist auch falsch. Mein WindowSpy gibt mir bei mir eine andere Childklasse zurück.
Ich denke, das mit dem FindWindowEx kannst Du vergessen.

Die Idee mit dem Fenstertext ist da ein schon besserer Ansatz. Funktioniert Deine Abfrage? Bei mir nicht.

Hier ist ein früherer Artikel von mir. Ist zwar nicht das gleiche Thema, aber gibt Einblicke in eine mögliche Programmierung.
https://www.herber.de/forum/archiv/1976to1980/1979969_Bildschirm_teilen_fuer_Excel_und_Edge.html#5

Wenn ich Zeit habe, werde ich Deinen Wunsch hieraus mal entwickeln, oder Du machst es selbst. :-)

PS: Wie kommst Du auf PostMessage? PostMessage sendet Messages in die Windows-Nachrichtenschleife. Diese Nachrichten werden irgendwann mal abgearbeitet.
Welche Message willst Du damit verschicken? Ich verwende PostMessage nur mit der Message WM_CLOSE.

Zum Setzen der App in den Vordergrund brauchst Du das richtige Handle. Wurde das in Deinem Code ermittelt?

Gruß
Karl-Heinz

AW: Doppelte Webseite öffnen verhindern

01.12.2024 13:08:21

volti

Hallo Sigi,

hier ein neuer Ansatz. Vielleicht hilft er ja.....
Url und Fenstersuchtext musst Du noch anpassen.

Code:


Option Explicit
Option Compare Text

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" ( _
        ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
        ByVal lpEnumFunc As LongPtr, ByVal lparam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowTextA Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal lpString As String, _
        ByVal cch As Long) As Long
Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long

Private Type GetWndParam_STRUCT
    hwnd         As LongPtr
    sWindowTitle As String
    sClassname   As String
End Type
Dim tParams As GetWndParam_STRUCT


Private Function GetWindowLike(sWindowTitle As String, sClassname As String) As LongPtr
' Ermittelt das Handle eines Fensters anhand eines Teiltextes und /oder  Klasse
  With tParams
     .sWindowTitle = sWindowTitle                       ' Suchtext übernehmen
     .sClassname = sClassname                           ' Suchklasse übernehmen
     .hwnd = 0
     Call EnumWindows(AddressOf EnumWindowProc, VarPtr(tParams))
     GetWindowLike = .hwnd                              ' Gefundenes Handle zurückgeben
  End With
End Function

Private Function EnumWindowProc(ByVal hwnd As LongPtr, _
                                lparam As GetWndParam_STRUCT) As Long
  Dim sText As String * 255
  
  With lparam
     Call GetClassNameA(hwnd, sText, 255)              ' Klassenamen holen
     If Left$(sText, InStr(sText, vbNullChar) - 1) Like .sClassname Then
        Call GetWindowTextA(hwnd, sText, 255)          ' Fenstertext holen
        If Left$(sText, InStr(sText, vbNullChar) - 1) Like .sWindowTitle Then
           lparam.hwnd = hwnd                          ' Handle übernehmen
           EnumWindowProc = 0: Exit Function
        End If
     End If
  End With
  EnumWindowProc = 1
 End Function
 
 
Private Sub OpenWebSite()
  Const csEdgePath As String = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
  Const csUrl      As String = "https://www.herber.de/forum"
  Const csSuch     As String = "Herbers Excel"
  Const csClass    As String = "Chrome_WidgetWin_1"
    
' Microsoft Edge starten (Pfad anpassen, falls notwendig)
  With tParams
     Call GetWindowLike(csSuch & "*Edge", csClass)
     If .hwnd = 0 Then
        Shell csEdgePath & " """ & csUrl & """", vbNormalFocus
        Sleep 2000
        Call GetWindowLike("*Edge", csClass)
     End If
     If .hwnd > 0 Then
        SetForegroundWindow .hwnd
        ShowWindow .hwnd, 1              ' 1=SW_NORMAL
     End If
  End With
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Doppelte Webseite öffnen verhindern

01.12.2024 15:47:20

volti

Hi,

Private Declare PtrSafe Function ShowWindow Lib "user32" ( _

        ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long

fehlt noch, wenn Du das verwenden möchtest.
Das war bei mir noch in einem anderen Modul der Mappe modulübergreifend deklariert, da fiel das nicht aus...

Gruß KH

AW: Doppelte Webseite öffnen verhindern

02.12.2024 05:17:33

sigiF

Hallo Karl-Heinz,

vielen Dank! Deine Lösung funktioniert einwandfrei.
Gruß, Sigi

Doppelte Webseite öffnen verhindern

Forumthread: Doppelte Webseite öffnen verhindern

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Doppelte Webseite öffnen verhindern

Forumthread: Doppelte Webseite öffnen verhindern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread