HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

VBA ClickBot featuring AJAX waiting and Element searching

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
ajaxsearchingclickbotwaitingfeaturingelementvbaand

Problem

If you work with a database that you only have access through a web interface, this one is for you. You probably don't have access to any programming languages other than VBA through MS Office, which I 95% guarantee you do have.

Since we will be controlling an external instance of Internet Explorer, you will need to reference Mircosoft Internet Controls for this to work. One could hack this to work with Firefox or Chrome with extensions like Selenium.

Usage

This is meant to be placed in an add-in so we can create an instance from the pseudo-constructors.

Dim navi As Gator
Set navi = Gator.Home("https://www.google.com/", php:=False)


Navigating to a url will raise an error if the browser doesn't navigate to the requested URL. The php:=False option ignores trailing php code added. You can also grab an existing instance of IE using the window title.

Set navi = Gator.FromWindow("Google")


It's nifty if you don't want to re-login to a database or catch a popup window.

There are currently two ways to access HTML elements on the page.

  • By id or name



  • Using HtmlFields object



By id is the recommended method if available. You find the id or name of the element and use

With Gator.Home("http://codereview.stackexchange.com/")
    .GetElByID("nav-questions").Click
End With


If the element does not have an ID you can specify the tag of the element and any other properties of the sought element

With Gator.Home("http://codereview.stackexchange.com/questions/69009/vba-clickbot-featuring-ajax-waiting-and-element-searching")
    .FindEl(HtmlFields.Make("a", innerText:="up vote", _
        title:="This question shows research effort; it is useful and clear")).Click
    .FindEl(HtmlFields.Make("a", innerText:="add a comment")).Click
    .FindEl(HtmlFields.Make("textarea")).value = "WOW! This is super neat!"
    .FindEl(HtmlFields.Make("input", value:="Add Comment")).Click
End With


I highly recommend you give that a try

Notice

Solution

I have to say that this is pretty damn impressive. Really. I'm not going to go through this line by line; my general impression is that it looks pretty readable, procedures are of decent length, it's clear what's going on.

I wonder why the late binding here:

Private criteria As Object
Private Sub Class_Initialize()
    Set criteria = CreateObject("Scripting.Dictionary")
End Sub


With a reference to the Scripting library, it could look like this:

Private criteria As New Scripting.Dictionary


And nothing in the Initialize handler. But this whole binding point is moot, I'll get back to why.

There's this Make function:

Public Function Make(...)


The function is being assigned a new instance of HtmlFields, and then that instance is being modified:

Set Make = New HtmlFields
With Make

    If tagName = "" Then
        Err.Raise 720, "HtmlFields.Make", "tagName cannot be a null string"
    End If

    .Add "tagName", UCase(tagName)
    .Add "className", className
    .Add "value", value
    .Add "innerText", innerText
    .Add "innerHTML", innerHTML
    .Add "type", typeName
    .Add "title", title
    .Add "href", href
    .Add "style", style

End With


I like the usage you've made of the With statement, but not how you're using the function's handle as a simple object variable; you and I know that it can be used like that, but it's always better not to. I'd much rather like to see this:

Set result = New HtmlFields
With result

    If tagName = "" Then
        Err.Raise 720, "HtmlFields.Make", "tagName cannot be a null string"
    End If

    .Add "tagName", UCase(tagName)
    .Add "className", className
    .Add "value", value
    .Add "innerText", innerText
    .Add "innerHTML", innerHTML
    .Add "type", typeName
    .Add "title", title
    .Add "href", href
    .Add "style", style

End With

Set Make = result


It's not only a matter of personal preference: treating the function's identifier as a variable can lead to unexpected issues if you're not careful, and almost always creates a little surprise to the reader.


I would prefer to allow users to specify the property name of the element searching for instead of restricting them to the one's I have provided.

Oh yeah. Ok. Ready for a little bit of oop?

Attribute VB_Name = "HtmlField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Private Type THtmlField
    FieldName As String
    FieldValue As String
End Type

Private this As THtmlField

Public Function Make(ByVal field As String, ByVal value As String) As HtmlField

    Dim result As New HtmlField
    result.FieldName = field
    result.FieldValue = value

    Set Make = result

End Function

'default property:
Public Property Get FieldName() As String
    Attribute FieldName.VB_UserMemId = 0
    FieldName = this.FieldName
End Property

Friend Property Let FieldName(ByVal value As String)
    If value = vbNullString Then
        Err.Raise 720, "HtmlField.FieldName (Property Let)", "Invalid argument: [value] cannot be set to an empty string."
    End If
    this.FieldName = value
End Property

Public Property Get FieldValue As String
    FieldValue = this.FieldValue
End Property

Friend Property Let FieldValue(ByVal value As String)
    this.FieldValue = value
End Property


So we have this sort-of-public-interface-immutable type with a default instance, that encapsulates its own validation rule(s). With the first recommended modification, this means we can now remove all these optional parameters and have the Make function look like this:

Public Function Make(ByVal tagName As String, ) As HtmlFields

    Set Make = New HtmlFields
    With Make

        If tagName = "" Then
            Err.Raise 720, "HtmlFields.Make", "tagName cannot be a null string"
        End If

        .Add "tagName", UCase(tagName)
        .Add "className", className
        .Add "value", value
        .Add "innerText", innerText
        .Add "innerHTML", innerHTML
        .Add "type", typeName
        .Add "title", title
        .Add "href", href
        .Add "style", style

    End With

End Function


And now we don't need this anymore, because value is never going to be blank:

''
' If value is blank then the option wasn't provided.
Friend Sub Add(ByVal key As String, ByVal value As String)
    If value <> "" Then criteria.Add key, value
End Sub


Actually, the HtmlField abstraction implements the key/value concept; there's no need to use a Scripting.Dictionary anymore, because instead of this:

Public Function IsMatch(ByVal element As Object) As Boolean

    Dim pass As Boolean
    Dim field As Variant
    For Each field In criteria.Keys

        pass = (CallByName(element, field, VbGet) = criteria(field))
        If Not pass Then Exit For

    Next field

    IsMatch = pass

End Function


We could have that:

```
Public Function IsMatc

Code Snippets

Private criteria As Object
Private Sub Class_Initialize()
    Set criteria = CreateObject("Scripting.Dictionary")
End Sub
Private criteria As New Scripting.Dictionary
Public Function Make(...)
Set Make = New HtmlFields
With Make

    If tagName = "" Then
        Err.Raise 720, "HtmlFields.Make", "tagName cannot be a null string"
    End If

    .Add "tagName", UCase(tagName)
    .Add "className", className
    .Add "value", value
    .Add "innerText", innerText
    .Add "innerHTML", innerHTML
    .Add "type", typeName
    .Add "title", title
    .Add "href", href
    .Add "style", style

End With
Set result = New HtmlFields
With result

    If tagName = "" Then
        Err.Raise 720, "HtmlFields.Make", "tagName cannot be a null string"
    End If

    .Add "tagName", UCase(tagName)
    .Add "className", className
    .Add "value", value
    .Add "innerText", innerText
    .Add "innerHTML", innerHTML
    .Add "type", typeName
    .Add "title", title
    .Add "href", href
    .Add "style", style

End With

Set Make = result

Context

StackExchange Code Review Q#69009, answer score: 4

Revisions (0)

No revisions yet.