asked on

Looking for sample code on how to impliment "WithEvents" in a class for web pages

I am trying to build an application. I have a need to work with several web pages at a time.
I had a question that "eeshahidt" and I had some dialog on and he told me I what I needed. Working with his suggestions and guidance. I thought I would be able to build the class modules with help I was able to garner from the 'net.
But I have not been able to find samples that work properly as they are, much less modify them.
There do seem some good sites with detailed info (http://www.tushar-mehta.com/publish_train/xl_vba_cases/vba_web_pages_services/) is the one I have used the most, but I just have not been able to get it to work! I have followed his steps, and tried to create the workbook as he said, and the first few samples seem to work, but one I get to the post and get samples (which is the way I need to work with the sites I am working with) I am falling flat on my face!
First, I DO have a working app. But it is slower than it could be I feel. So I have all the proper calls to the variables, I am able to manipulate the pages, and extract the info, push and save info to the site, so I have all of the mechanics down. I currently am NOT using events, so I have alot of waiting for .Busy & .ReadyState <> 4. Then processing the next url. (I am batch processing 20 sites at the same time, loading them all, then waiting for all to become ready, then getting data) As "eeshahidt" pointed out to me, using "withevents" would be much better and allow me to process these in a much more streamlined manner. Using withevents seems I must use classes.

So... help me please!
The websites I am using are corporate internal sites behide firewalls. I can provide code for the sites, or my workbook.

Option Explicit
sub TestCall()
dim process_BACC as boolean
process_BACC = true
'This procedure was origanally configured to work with 20 copies of the site, but this site is fast enough, taking the overhead does not seem justified. BACCArray(1) is the object that houses the web. and is declared Public BACCArray(20) As Object
         If process_BACC Then
                Call openBACC
                Call STEPBACC1by1(2, 1)
            End If
end sub 


Sub openBACC()
    Dim PageOpened(20) As Boolean
    ' we will open the BACC screens here
    'For i = 1 To 2
    Set BACCArray(1) = CreateObject("Internetexplorer.Application")
    Call OpenNewBACC(BACCArray(1))
    'Next
    'make sure all are on right page
    'For i = 1 To 2
    Call SetBACCtoQuery(BACCArray(1))
    'Next
    ' and make sure the all are open here
    'For i = 1 To 2
    PageOpened(1) = False
    Do While Not PageOpened(1)
        PageOpened(1) = WebWait(BACCArray(1), "<title>BACC Device Search Screen")
    Loop

    'MsgBox "Opened BACC copy " & i
    'Next
    AppActivate "Microsoft Excel"
    Excel.Application.Visible = msoTrue
    ' MsgBox "Done Opening BACC Screens"
End Sub
Sub STEPBACC1by1(STEPBACCRecNo As Long, ColMarker As Integer)
    Dim STEPBACCpage(1) As String
    Dim STEPBACCPageLen(1) As Long
    Dim STEPBACCPageLen2(1) As Long
    Dim STEPBACCSN(1) As String
    Dim STEPBACCResults(1) As Boolean
    Dim TempObj As Object
    Dim lr As Long
    Dim o As Long
    Dim StartingRec As Long

    Dim StepBacci As Long
    Dim SearchRange As Range
    Dim teststring As String
    Dim tr As String
    Dim Elea As Variant

    BACCReset
    lr = FindLastrow()
    For o = 2 To lr - 1
        StartingRec = STEPBACCRecNo
        Cells(o, 1).Select
        If Not Cells(STEPBACCRecNo, 1) = "" Then

            STEPBACCSN(1) = Cells(o, 1)
            BACCArray(1).Visible = False
            Call OpenMACinBACC(BACCArray(1), STEPBACCSN(1))
            While BACCArray(1).Busy
                DoEvents
            Wend
            While BACCArray(1).ReadyState <> 4
                DoEvents
            Wend
            Application.Wait Now + TimeValue("00:00:01")
            STEPBACCpage(1) = BACCArray(1).document.DocumentElement.outerHTML
            STEPBACCPageLen(StepBacci) = Len(STEPBACCpage(StepBacci))
        End If
        STEPBACCRecNo = STEPBACCRecNo + 1
        Set SearchRange = ActiveSheet.Range("A:A")
        '  BACCArray(1).Visible = False
        While BACCArray(1).Busy
            DoEvents
        Wend
        While BACCArray(1).ReadyState <> 4
            DoEvents
        Wend
        STEPBACCpage(1) = BACCArray(1).document.DocumentElement.outerHTML
        'Test and stuff results
        teststring = LCase(STEPBACCpage(1))
        tr = InStr(teststring, LCase("Error while retrieving devices from"))
        Elea = BACCArray(1).document.getElementsByName("delmacaddr")
        If Not VarType(Elea) = 9 Then
            '     MsgBox "Here"
        End If

        If InStr(teststring, LCase("Error while retrieving devices from")) > 0 Then
            STEPBACCResults(1) = False
        ElseIf InStr(teststring, LCase("DOCSISModem")) > 0 Then
            STEPBACCResults(1) = True
            If Trim(Cells(o, 11)) = "Not Owned" Then
                Call BACCDeleteSN(BACCArray(1), Cells(o, 1))
                Application.Wait Now + TimeValue("00:00:01")
                ' BACCReset

            End If
            '   elseif BACCArray(1).document.BACCMtaSearchBean.delmacaddr.value
        ElseIf Application.Substitute(Right(BACCArray(1).document.BACCMtaSearchBean.delmacaddr.Value, 17), ":", "") = LCase(STEPBACCSN(1)) Then

            If Trim(Cells(o, 11)) = "Not Owned" Then
                Call BACCDeleteSN(BACCArray(1), Cells(o, 1))
                Application.Wait Now + TimeValue("00:00:01")
                ' BACCReset

            End If

        ElseIf InStr(LCase(teststring), SNExpanded(STEPBACCSN(StepBacci))) > 0 Then
            STEPBACCResults(1) = True
            AppActivate "Microsoft Excel"
            AppActivate "Microsoft Excel"
            Excel.Application.Visible = msoTrue
            MsgBox "Please Delete BACC - here!"

            o = o - 1
            STEPBACCRecNo = STEPBACCRecNo - 1
            ' STEPBACCResults(1) = True
            '  AppActivate "Microsoft Excel"
            '  zz = Cells(o, 7)
        End If
        Cells(Application.Match(STEPBACCSN(1), SearchRange, 0), 3 + ColMarker) = STEPBACCResults(1)
        BACCReset
    Next
    Call BACCCloseAll

End Sub
Function OpenNewBACC(BACC As Object) As Object
    Dim web As String
    Dim PageOpened As Boolean
    Dim spage As String
    Dim BACC1 As Object
    Dim test1 As Object
   
    Dim Link As MSHTML.HTMLAnchorElement

    'Here we are opening NEW instances of BACC
    'web = "http://comcastbaccgui.comcast.net/bacc/jsp/bacc_main_menu.jsp"
    web = "http://comcastbaccgui.comcast.net/bacc/jsp/devices.do"
    'Set BACC = CreateObject("Internetexplorer.Application")
    BACC.Visible = True
    BACC.Navigate web
    'PageOpened = WebWait(BACC, "<title>BACC")

    While BACC.Busy
        DoEvents
    Wend
    While BACC.ReadyState <> 4
        DoEvents
    Wend
    Do While True

        'BACC Device Search Screen
        If BACC.document.Title = "BACC Device Search Screen" Then
            Exit Do

        End If
        'if login page, login
        '  spage = BACC.document.DocumentElement.outerHTML
        If BACC.document.Title = "BACC (Login Screen)" Then
            bacclogingscreen BACC
        End If

        ' Call WebWait(BACC, "Please select RDU id/IP/APOP pair/IP Version")
        If BACC.document.Title = "BACC GUI RDU Main Screen" Then
            baccRNUScreen BACC
        End If

        'Deal with the Devices page
        If BACC.document.Title = "BACC Administrator User Interface - Main Menu" Then
            BACCDevicesscreen BACC
        End If



    Loop
End Function
Sub bacclogingscreen(BACC As Object)

    If Not Len(Username) > 0 Then
        Excel.Application.Visible = msoTrue
        fNTLogin.Show
        ' username = InputBox(prompt:="Please enter your NT User Name", Title:="NT User Name", Default:="NT User Name")
        ' pw = InputBox(prompt:="Please enter your NT Password", Title:="NT Password", Default:="NT Password")
        Username = fNTLogin.Username
        pw = fNTLogin.Password
    End If
    With BACC.document.BACCLogin
        .all.item("userid").Value = Username
        .all.item("Password").Value = pw
        .submit.Click

    End With
    While BACC.Busy
        DoEvents
    Wend
    While BACC.ReadyState <> 4
        DoEvents
    Wend

End Sub
Sub baccRNUScreen(BACC As Object)
    With BACC.document.form1
        .elements("rdu")(0).Value = "RDU05 - 68.87.83.32 - San Jose - IPV6"
        .elements("rdu")(1).Value = "RDU05 - 68.87.83.32 - San Jose - IPV6"
        .submit
    End With
    While BACC.Busy
        DoEvents
    Wend
    While BACC.ReadyState <> 4
        DoEvents
    Wend

End Sub
Sub BACCDevicesscreen(BACC As Object)
 Dim ELEMENTCO1 As Object
   Dim Link As MSHTML.HTMLAnchorElement

    Set ELEMENTCO1 = BACC.document.getElementsByTagName("a")
    AppActivate "Microsoft Excel"
    Excel.Application.Visible = msoTrue
    For Each Link In ELEMENTCO1
        If Link.innerHTML = "Devices" Then
            Link.Click

            Exit For
        End If
    Next Link
    While BACC.Busy
        DoEvents
    Wend
    While BACC.ReadyState <> 4
        DoEvents
    Wend
End Sub
Function SetBACCtoQuery(BACC As Object) As Boolean
    Dim web As String
    Dim SetBACCtoQueryPage As String
    web = "http://comcastbaccgui.comcast.net/bacc/jsp/devices.do"
    SetBACCtoQueryPage = UCase(BACC.document.DocumentElement.outerHTML)
    If InStr(SetBACCtoQueryPage, UCase("<title>BACC Device Search Screen")) = 0 Then
        BACC.Navigate web
    End If
End Function
Sub BACCReset()
    Dim BACCResetCounter As Integer
    BACCResetCounter = 1
    '  For BACCResetCounter = 1 To 2
    With BACCArray(BACCResetCounter)
        .Navigate "http://comcastbaccgui.comcast.net/bacc/jsp/devices.do"
    End With
    '   Next
End Sub

Function OpenMACinBACC(BACC As Object, mac As String) As Boolean
    Dim imac As String
    imac = (Trim(mac))
    BACC.Navigate "http://comcastbaccgui.comcast.net/bacc/jsp/devices.do"

    '  BACC.Visible = False
    While BACC.Busy
        DoEvents
    Wend
    While BACC.ReadyState <> 4
        DoEvents
    Wend
    With BACC.document.BACCMtaSearchBean  'document name = "BTS" form name = "BTSQueryBean"
        .searchquery.Value = imac
    End With

    With BACC.document.BACCMtaSearchBean  'document name = "BTS" form name = "BTSQueryBean"
        .searchbutton.Click
    End With

End Function


Sub BACCDeleteSN(o_BACCDeleteSN As Object, BACCDeleteSN_SN As String)
    Dim o_BACCDeleteSNPage As String
    Dim BACCDeleteSN_SNTest As String
    Dim ELEMENTCOL As Object
    Dim o_BACCDeleteSNInputs As MSHTML.IHTMLElementCollection
    Dim btnInput As MSHTML.IHTMLInputElement
    Dim t As Boolean


    ' Open 1 instance of BTS

    'Verify we are deleting the right BACC
    'With o_BACCDeleteSN.document.BACCMtaSearchBean
    o_BACCDeleteSNPage = LCase(o_BACCDeleteSN.document.DocumentElement.outerHTML)
    BACCDeleteSN_SNTest = LCase(SNExpanded(BACCDeleteSN_SN))
    If InStr(1, o_BACCDeleteSNPage, BACCDeleteSN_SNTest, vbTextCompare) > 0 Then
        Set o_BACCDeleteSNInputs = o_BACCDeleteSN.document.getElementsByTagName("input")
        o_BACCDeleteSN.document.BACCMtaSearchBean.SelectAll.Click
        'Set o_BACCDeleteSNBTNELEMENTCOL = o_BACCDeleteSN.document.getElementsByTagName("INPUT")

        For Each btnInput In o_BACCDeleteSNInputs
            If btnInput.Value = " DELETE " Then

                ' btnInput.Click
                btnInput.onclick = ""  'or btnInput.removeAttribute("onclick")
                'SendMessage Hndb, BM_CLICK, 0, 0
                t = DeleteBacc(o_BACCDeleteSN)
                Exit For
            End If
        Next btnInput
        ' MsgBox "Here"
        'Call DeleteBacc

    End If


End Sub
Sub BACCCloseAll()
    Dim BACCCloseAllCounter As Integer
    BACCCloseAllCounter = 1
    ' For BACCCloseAllCounter = 1 To 2
    With BACCArray(BACCCloseAllCounter)
        .Quit
    End With
    ' Next
End Sub

Function DeleteBacc(o_BACCDeleteSN As Object) As Boolean
    With o_BACCDeleteSN.document.BACCMtaSearchBean  'document name = "BTS" form name = "BTSQueryBean"
        .Action.Value = "DELETE_DEVICES"
        .searchbutton.disabled = True
        .submit
    End With

    'since I am no longer looking for the "OK" button, I don't need the other code at all
    'with
    'o_BACCDeleteSN.BACCMtaSearchBean.Action.Value = "DELETE_DEVICES"
    'o_BACCDeleteSN.body.Style.Cursor = "wait"
    'o_BACCDeleteSN.BACCMtaSearchBean.searchbutton.disabled = True
    'o_BACCDeleteSN.BACCMtaSearchBean.submit
    'DeleteBacc = whateverValidationTestsIWant()

End Function

Open in new window

Jan Karel Pieterse

Hi,

If you use a userform with the Internet Explorer control, using the events is simple, see attached example.
InternetExplorerEvent.xls

Bruj

ASKER

OK, this is working, but I am not sure of the next step.
I have it opening and mimicking the label name change like you have, now, how would I continue to process more info? Here is the code that I current have duplicated.
[code]
Option Explicit

Private WithEvents moIE1 As InternetExplorer
Private WithEvents moIE2 As InternetExplorer
Private WithEvents moIE3 As InternetExplorer
Private WithEvents moIE4 As InternetExplorer
Private WithEvents moIE5 As InternetExplorer
Private WithEvents moIE6 As InternetExplorer
Private WithEvents moIE7 As InternetExplorer
Private WithEvents moIE8 As InternetExplorer

Private Sub moIE1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label1.Caption = "Now we've loaded the page"

End Sub

Private Sub moIE1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label1.Caption = "We're done going to the site"
End Sub
Private Sub moIE2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label2.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE2_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label2.Caption = "We're done going to the site"
End Sub
Private Sub moIE3_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label3.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE3_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label3.Caption = "We're done going to the site"
End Sub
Private Sub moIE4_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label4.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE4_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label4.Caption = "We're done going to the site"
End Sub
Private Sub moIE5_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label5.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE5_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label5.Caption = "We're done going to the site"
End Sub
Private Sub moIE6_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label6.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE6_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label6.Caption = "We're done going to the site"
End Sub
Private Sub moIE7_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label7.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE7_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label7.Caption = "We're done going to the site"
End Sub
Private Sub moIE8_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label8.Caption = "Now we've loaded the page"
End Sub

Private Sub moIE8_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Label8.Caption = "We're done going to the site"
End Sub

Private Sub UserForm_Initialize()

WebBrowser1.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE1 = WebBrowser1
WebBrowser2.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE2 = WebBrowser2
WebBrowser3.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE3 = WebBrowser3
WebBrowser4.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE4 = WebBrowser4
WebBrowser5.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE5 = WebBrowser5
WebBrowser6.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE6 = WebBrowser6
WebBrowser7.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE7 = WebBrowser7
WebBrowser8.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE8 = WebBrowser8

End Sub

and then
Private Sub moIE1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
titles(1) = pDisp.Document.Title
status(1) = True
End Sub

Would the above be the correct idea of what I want to do?
[/code]

what I need to do is
1.) check what page I landed on, is it a login page, is fo, login
do while...
2.) make sure I am on the QUERY page
3.) enter data and submit
4.) check the results

loop

Should I change initailize module to be something like
dim itemstoprocess(200) as string
dim title(10) as string
dim status(10) as boolean
for i = 1 to 10
title(i) = ""
status(i) = false
next

WebBrowser1.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE1 = WebBrowser1
.
.
.
WebBrowser10.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
Set moIE10 = WebBrowser10
cnt=1
do while true
for i = 1 to 10
if status(x) = true
if title(x) = "BTS Softswitch Provisioning System (Login Screen)"
login()
end if
if title(x) = "BTS Main Screen"
gotoquery()
end if
if title(x) = "BTS Query Screen"
testitem = itemstoprocess(cnt)
cnt=cnt+1
PushQuery(testitem )
end if
if title(x) = "BTS Detail Screen"
GetInfo()
WebBrowser1.Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do"
end if

end if

next
if cnt=201 then exit do

loop

Also, is there a way (using VBA, NOT VB) to create the webpages as
WebBrowser(1).Navigate2 "http://comcastbtsgui.comcast.net/bts/jsp/main.do" (an array)
Or someway to use the
for/next loop to process WebBrowser1 thru WebBrowser10?
Appaently, VBA does NOT have control arrays, which looks like it would be what I am looking for.

Thanks
Bruce

Jan Karel Pieterse

You can do this a lot simpler by opening multiple instances of the form. Which in fact means we treat the form as a class. I added a normal module to the sample workbook and simplefied the code behind the form a little, the withevents construct is not needed as that is already handled by VBA "under the hood". I have attached a new example file. Look at what I do in Module1.
InternetExplorerEvent.xls

Jan Karel Pieterse

NB: Of course when all pages have been processed, you need to remove the instances of the form from memory. You do that with this simple command:

Set mcWebPages = Nothing

Bruj

ASKER

jkpieterse, when I run the code, it does not call EnumerateThem, so I added this to the end of DEMO, when it runs, mcWebPages, only has 1 item in the following (goes thru it just once)

For Each oWeb In mcWebPages
If oWeb.Done Then
Debug.Print oWeb.URL & " is ready"
Else
Debug.Print oWeb.URL & " is busy"
End If
Next

Also, is there a way to identify each oWeb from each other? Example, I want to submit a different serial number in each module, is there a way I can track the results for the serial number that was submitted in oWeb OccuranceX?

Thanks
Bruce

Jan Karel Pieterse

You can address each element of the mcWebPages collection by it's index or it's key. Since I used the URL for the key, simply use the url the page is loading:
Dim oWeb as ufWeb
Dim sURL as string
sUWL="http://www.jkp-ads.com"
Set oWeb = mcWebPages(sURL)

Bruj

ASKER

Unforutantly, these will be addressing the same URL... Is there a way to assign a differnt key than the URL?

Thanks
Bruce

Jan Karel Pieterse

Of course, you can use any unique string as a key.

Bruj

ASKER

jkpieterse
I ALMOST have it.... I think
What is happening now is that if there is a duplicate of websites, all but 1 stay "BUSY"
I have attached my worksheet. I am testing with GOOGLE as my site, just to make sure it is not something funcky with our site.

Again, Thanks
Bruce

InternetExplorerEvent-1--Mod3.xls

ASKER CERTIFIED SOLUTION

Jan Karel Pieterse

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bruj

ASKER

jkpieterse:

That does it!
I do have a few questions, but I will open new questions in a while to get those answers!

I did need to put the
Do While True
DoEvents
Loop

to get the last site, but I figured I would probably need to do that any ways.

Thank you VERY much!

Jan Karel Pieterse

Where did you put the do while loop? It worked for me without that loop.

Bruj

ASKER

I put it after the last " OpenWebPage" call. I would need to put my control loop here to keep restuffing the sites.
Now... I do have a questions. I am testing and stumbling to try to figure it out:)
In the following,
Private Sub oIE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If mbReady Then Exit Sub
mbReady = True
'Set a flag that this one is ready
Done = True
'Now fire a routine in the normal module to do something
LetKnowWereDone URL, ThisInstance
End Sub
mbReady means to exit this module for this instance (once it have fired). What happens if I hit a "submit" button, and it switches pages. Should I set this BACK to FALSE before hitting the submit?
Also, how should I handle stepping through pages? (I have a more detailed explanation at https://www.experts-exchange.com/questions/26001235/Looking-for-recommendation-of-how-to-approach-this.html)
(I did not know about the ask a related question link above.)

Thanks Bruce

Jan Karel Pieterse

I put in the mbready trick because the event seems to fire twice for each page and didn't want that to happen.
I had a closer look and what happens is that IE firstloads it default page and then loads your url, so the documentready event fires twice. WHat we need to do is have the event fire each time the url changes, EXCEPT the first time. See attached.
InternetExplorerEvent-1--Mod3JKP.xls

Looking for sample code on how to impliment &quot;WithEvents&quot; in a class for web pages

Looking for sample code on how to impliment "WithEvents" in a class for web pages