Fire BeforeNavigate2 Event

[EZEason]

I have a class that watchs web sites open. That works fine, but I can not get the "BeforeNavigate2" event to fire.

'**** in my module****
Global SW As New SHDocVw.ShellWindows
Private SWC As New clsShellWindowsEvents
    Public Sub subWindowsOpen()
       Set SWC.shellWindowsEvent = SW
       Set SWC.WebBrowserEvent = New SHDocVw.WebBrowser
    End Sub

'**** in my Class****
Option Explicit
Public WithEvents shellWindowsEvent As SHDocVw.ShellWindows
Public WithEvents WebBrowserEvent As SHDocVw.WebBrowser

Private Sub shellWindowsEvent_WindowRegistered(ByVal lCookie As Long)
        frmShellWindows.BackColor = vbBlack
End Sub

Private Sub shellWindowsEvent_WindowRevoked(ByVal lCookie As Long)
        frmShellWindows.BackColor = vbWhite
End Sub

Private Sub WebBrowserEvent_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
   frmShellWindows.BackColor = vbGreen
End Sub

What am I doing wrong?
I do not think this will work with multi browsers. Is there a way to have it watch all open browsers? How???


What doesn't kill you makes you stronger.

 

[combo]

You need to assign real browser to proper WithEvents variable.
For the first browser (windows explorer or internet explorer):
Set SWC.WebBrowserEvent = SWC.shellWindowsEvent(0)

I would suggest to split ShellWindows and WebBrowser(one shellwindows vs. multiple browsers) event classes, it would be also convenient to instantiate browser class every time WindowRegistered event fires (and destroy when Revoked). lCookie parameter can be used to mark browser for shellwindow events.
ShellWindows collection of WebBrowsers starts counting from 0 and Item is the default property.

You could get more control on instantiating using two-line syntax:
Private SWC As clsShellWindowsEvents
Set SWC = New clsShellWindowsEvents

combo

 

[EZEason]

Thank you so much for your help!
OK, I'm never done a class instantiate. Can you help me through it? I have split the WebBrowser into its own class.

Here is the Shell class:

'****clsShellWindowsEvents***
    Option Explicit
    Public WithEvents shellWindowsEvent As SHDocVw.ShellWindows
    Private Sub Class_Initialize()
       
    End Sub
    Private Sub Class_Terminate()
        
    End Sub


    Private Sub shellWindowsEvent_WindowRegistered(ByVal lCookie As Long)
        frmShellWindows.BackColor = vbBlack
    End Sub


    Private Sub shellWindowsEvent_WindowRevoked(ByVal lCookie As Long)
        frmShellWindows.BackColor = vbWhite
    End Sub

Here is the WebBrowser Class:

'****clsWebBrowserEvents****
    Option Explicit
    Public WithEvents WebBrowserEvent As SHDocVw.WebBrowser
    Private Sub Class_Initialize()
        '...placeholder comment
    End Sub
    Private Sub Class_Terminate()
        '...placeholder comment
    End Sub
        
Private Sub WebBrowserEvent_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
       
        rmShellWindows.BackColor = vbGreen
        Console.WriteLine URL
 End Sub

As you suggested:
You could get more control on instantiating using two-line syntax:
Private SWC As clsShellWindowsEvents
Set SWC = New clsShellWindowsEvents

Where should I place this? In my module's "Main Sub" or my "subWindowOpen"? Or is there a better place?

Now for:
Set WBC.WebBrowserEvent = SWC.shellWindowsEvent(0)
Where to place this?

Also you said:
It would be also convenient to instantiate browser class

How do I achive this?


What doesn't kill you makes you stronger.

 

[combo]

OK, I've created a short test in VBA (excel, with UserForm and class module, listbox and label on the userform). Hope that you will easily translate this into pure VB.

UserForm (form equivalent) module:

Me.ListBox1.AddItem Format(Time, "hh:nn:ss") & " " & Format(lCookie, "0000") & " WReg"
Set oWB = New clsWBEvents
Set oWB.ufParent = Me
Set oWB.ufList = Me.ListBox1
oWB.sCookie = Format(lCookie, "0000")
Set oWB.WebBrowserEvent = shellWindowsEvent(shellWindowsEvent.Count - 1)
colWB.Add Item:=oWB, key:=Format(lCookie, "0000")
End Sub

Private Sub shellWindowsEvent_WindowRevoked(ByVal lCookie As Long)
Me.BackColor = vbWhite
Me.ListBox1.AddItem Format(Time, "hh:nn:ss") & " " & Format(lCookie, "0000") & " WRev"
On Error Resume Next
colWB.Remove Format(lCookie, "0000")
End Sub

Private Sub UserForm_Initialize()
Set shellWindowsEvent = New SHDocVw.ShellWindows
Set colWB = New Collection
End Sub

Private Sub UserForm_Terminate()
Set shellWindowsEvent = Nothing
Set colWB = Nothing
End Sub

clsWBEvents class module:

Option Explicit
Public WithEvents WebBrowserEvent As SHDocVw.WebBrowser
Public ufParent As MSForms.UserForm
Public ufList As MSForms.ListBox
Public sCookie As String

Private Sub Class_Terminate()
Set ufParent = Nothing
Set ufList = Nothing
End Sub

Private Sub WebBrowserEvent_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
ufParent.BackColor = vbGreen
ufList.AddItem Format(Time, "hh:nn:ss") & " " & sCookie & " " & URL
End Sub

combo

 

[combo]

Sorry, the UserForm's full code should be:

Dim colWB As Collection
Dim oWB As clsWBEvents

Private WithEvents shellWindowsEvent As SHDocVw.ShellWindows

Private Sub ListBox1_Click()
Me.Label1.Caption = Me.ListBox1.Text
End Sub

Private Sub shellWindowsEvent_WindowRegistered(ByVal lCookie As Long)
Me.BackColor = vbBlack
Me.ListBox1.AddItem Format(Time, "hh:nn:ss") & " " & Format(lCookie, "0000") & " WReg"
Set oWB = New clsWBEvents
Set oWB.ufParent = Me
Set oWB.ufList = Me.ListBox1
oWB.sCookie = Format(lCookie, "0000")
Set oWB.WebBrowserEvent = shellWindowsEvent(shellWindowsEvent.Count - 1)
colWB.Add Item:=oWB, key:=Format(lCookie, "0000")
End Sub

Private Sub shellWindowsEvent_WindowRevoked(ByVal lCookie As Long)
Me.BackColor = vbWhite
Me.ListBox1.AddItem Format(Time, "hh:nn:ss") & " " & Format(lCookie, "0000") & " WRev"
On Error Resume Next
colWB.Remove Format(lCookie, "0000")
End Sub

Private Sub UserForm_Initialize()
Set shellWindowsEvent = New SHDocVw.ShellWindows
Set colWB = New Collection
End Sub

Private Sub UserForm_Terminate()
Set shellWindowsEvent = Nothing
Set colWB = Nothing
End Sub

combo

 

[EZEason]

I have it mostly working now, but I do get an error int the Registered event. On the Key:.
colWB.Add Item:=WBC, Key:=Format(lCookie, "0000")

Error: 457
"This key already associate with an element in the collection."

If I comment out the 'key:=Format(lCookie, "0000")
it will run , but then I get an error in the revoke,
colWB.Remove Format(lCookie, "0000")

Any suggestions?

What doesn't kill you makes you stronger.

 

[combo]

See what is going on with the collection. Key should be unique, this code format key as a four digits string. What is lCookie number?

combo

 

[BobRodes]

You basically have a key violation. When you try to add lCookie's value, it's saying it's already in the collection. I would step through your code, and keep looking at lCookie every time it comes up.

You don't mention the error when you try to remove it. Does it say that it isn't there, or something else?

<You could get more control on instantiating using two-line syntax:

FAQ faq222-6008 explains this in detail.

HTH

Bob

 

[EZEason]

The cookie is 3 digit number. I'm seeing what I and find.
I tried to convert he cookie to a string first, but still had the same error.

RobRodes:
That would seem to be the logical answer, but it errors on the first Key I add. I check the collection and it is empty. Just to test it I empted the collection before I add any data, and still had the same error.

I cant remeber the second error. One at a time, plus they are both related to the Key in the collection. So I hope that once the first problem is resolved the seceond will remedy it self.

Jim

What doesn't kill you makes you stronger.

 

[EZEason]

I found out why the first error was happening. The "shellWindowsEvent_WindowRevoked" event was firing twice with the same cookie. So I have it check the cookie before it adds it to the collection.

The second are is "Run Time Error #5: Invaild Procedure call or argument." in the "shellWindowsEvent_WindowRevoked". Then it high lights the "colWB.remove Format(lCookie, "0000")".

Still working on this one.

What doesn't kill you makes you stronger.

 

[BobRodes]

Aha, good find Jim! Please post your full solution when you find it.

Bob

 

[combo]

How many instances of of ShellWindows that handle events do you have?

combo

 

[EZEason]

Sorry I have been on end of month reports. Now back to programming. You ask:
How many instances of of ShellWindows that handle events do you have?

It will depend on how many browers are open. 1 for each browser. We are watching what website your employees go to on company laptops, when they are on the road. I will post the code in a day or two.

Jim

What doesn't kill you makes you stronger.

 

[combo]

ShellWindow track all opened browsers, and generates Window Register/Revoke events. So you need one instance only, otherwise one browser will be reported to your application more than once (assuming you have each declared using WithEvents and having event procedure created).
What you need is multiple WebBrowser instances, one for each browser.
There can some problems to solve, for instance handling existing browsers. You can consider switching into hWND identifier, as there is no lCookie for this browser.
Anyway, you need deeper understanding on classes and events, also on what is going on in your application and what you want to do. Otherwise it will be hard to complete this task.
I proposed a simple office vba application, strongly recommend to try to see it at work and understand how.

combo