Example function for navigating the DOM
Example function for logging into websites
Interacting with webpages from within VBA is made simple using Microsoft Internet Controls and the Microsoft HTML Object Library, (ieframe.dll, MSHTML.TLB). To use these libraries you need to add references in your excel macro to these two libraries tools -> references.
Once you have created your browser instance and navigated to a webpage you can then navigate the HTML DOM as you similarly would in other programming languages, eg
Set iHTMLCollection = HTMLDoc.all.tags("div"),
Set iHTMLCollection1 = iHTMLCollection.Item(8).Children.Item(0).Children.Item(1).Children,
If iHTMLCollection1.Item(0).getAttribute("outerHTML") > 0 Then,
If iHTMLCollection1.Item(1).outerHTML Like "*the moggy cat jumped*" The
There is already enough information out there on by Microsoft and via google to add any more VBA basics here, read on for a couple of vba functions related to browsing and the HTML DOM in VBA.
- Set IE = New SHDocVw.InternetExplorer
- IE.Visible = True
- IE.Navigate ("http://www.openreach.co.uk/orpg/customerzone/loadMyDashboard.do")
-
- Do While IE.Busy = True
- 'Animate Progress bar
- Loop
- Do While IE.ReadyState <> 4
- Loop
-
- Set HTMLDoc = IE.Document
- Do While HTMLDoc.ReadyState <> "complete"
- Loop
You will need a degree of page verification and also handling server errors, you could account for all possibilities but more likely the individual project will throw up a particular repeat issue to cater for, a 500 Internal Server Error page from an overworked server for example.
In this case it could be as simple as refreshing the page IE.Refresh and carrying on with parsing the HTML DOM.
- 'If we get "500 Internal Server Error" refresh the page and get document again
- If HTMLDoc.Title Like "500 Internal Server Error" Then
- IE.Refresh
- Application.Wait (Now() + TimeValue("00:00:" & 3))
- Do While IE.Busy = True
- Loop
- Do While IE.ReadyState <> 4
- 'Debug.Print ("'500 Internal Server Error' error fix")
- Application.Wait (Now() + TimeValue("00:00:" & 2))
- Loop
- End If
- Public Function NavigateHTML(ByVal tag As String, ByVal attr As String,
- ByVal ID As String, ByVal Stext As String)
-
- '########################################
- 'tag - Find elements by TagName: 'input' OR 'a' OR 'select... ect
- 'attr - Search for a particular Element attribute:
- ' name, href, type, className ...
- 'ID - Specify an identifier to look for in order to confirm element and
- ' carry out action.
- ' For elements which are of type;
- ' text, password :Enter text into element
- ' submit, button, reset, image :Click element
- ' href="*ID*" :Click on Hyperlink element
- ' checkbox, radio :Select element
- 'Stext - If looking for text/input box specify String to enter,
- ' or select a certain option.
- '
- 'Example usage:
- '
- 'Call NavigateHTML("a", "href", "accounts", "")
- '------
- '
- 'myUsername = ping
- 'myPass = pong
- 'Call NavigateHTML("input", "name", "Email", myUsername)
- 'Call NavigateHTML("input", "name", "Passwd", myPass)
- 'Call NavigateHTML("input", "value", "Sign in", "")
- '------
- '
- 'Call NavigateHTML("input", "src", "/includes/confirm.gif", "")
- '------
- '
- 'Call NavigateHTML("select", "name", "carManuf", "Skoda")
- '------
- '
- 'Call NavigateHTML("input", "className", "actionBtn", "")
- '------
- '##########
-
-
- Do While IE.Busy = True
- 'Animate Progress bar
- Loop
- Do While IE.ReadyState <> 4
- 'Animate Progress bar
- Loop
-
- Set HTMLDoc = IE.Document
- Do While HTMLDoc.ReadyState <> "complete"
- Loop
-
- Set iHTMLCol = Nothing
- While iHTMLCol Is Nothing
- Set iHTMLCol = HTMLDoc.all.tags(tag)
- Wend
-
-
- Select Case tag
-
- ' Click on hyperlink
- Case "a"
-
- For Each iHTMLEle In iHTMLCol
- If iHTMLEle.getAttribute("outerHTML") <> "" Then
- If iHTMLEle.outerHTML Like "*" & ID & "*" Then
- iHTMLEle.Click
- Stext = "True"
- Exit For
- Else
- Stext = "Could not find Attribute " & tag _
- & " for element type" & Stext
- End If
- End If
- Next
-
- ' Select option
- Case "select"
-
- For Each iHTMLSel In iHTMLCol
-
- If iHTMLSel.getAttribute(attr) <> "" Then
- aStr = iHTMLSel.getAttribute(attr)
- If aStr = ID Then
- For Each iHTMLOpt In iHTMLSel.Children
- If iHTMLOpt.getAttribute("value") = Stext Then
- iHTMLSel.selectedIndex = iHTMLOpt.Index
- End If
- Next
-
- Else
- 'Stext = "Could not find Attribute " & attr _
- & " for element type" & ID
- End If
- End If
- Next
-
- ' Various
- Case "input"
- For Each iHTMLEle In iHTMLCol
- If iHTMLEle.getAttribute(attr) <> "" Then
- aStr = iHTMLEle.getAttribute(attr)
- If aStr = ID Then
- Select Case ID
-
- ' Click button
- Case "submit", "button", "reset", "Submit", "Search"
- iHTMLEle.Click
- Stext = "True"
- Exit For
-
- ' Enter text into input box
- Case "text", "password"
- iHTMLEle.Value = Stext
- Stext = "True"
- Exit For
-
- ' Use Stext to identify the correct checkbox/radio if multiple
- Case "checkbox", "radio"
- If Stext = iHTMLEle.getAttribute("name") Or Stext = "" Then
- If iHTMLEle.Checked = False Then
- iHTMLEle.Checked = True
- Else
- iHTMLEle.Checked = False
- End If
- Exit For
- Else
- End If
-
- Case "image"
- Stext = "No action setup for Tag Image"
- Exit For
-
- Case Else
- If Stext <> "" Then
- 'Custom form entry
- iHTMLEle.Value = Stext
- Stext = "True"
-
- ElseIf Stext = "" Then
- 'Custom button click, click the button
- iHTMLEle.Click
- Stext = "True"
- Exit For
-
- Else
- 'We should not be here, unkown event
- Stext = "Unkown Tag: " & tag & ", Attr: " & attr & _
- ", ID: " & ID & ", Text: " & Stext
- End If
- Exit For
-
- End Select
- Else
- 'Stext = "Could not find Attr: " & attr & " for element: " & ID
- End If
- End If
- Next
- End Select
-
- Do While IE.Busy = True
- 'Animate Progress bar
- Loop
- NavigateHTML = Stext
-
- End Function
And of course the same goes if your logging into multiple sites, this LogIn function should be called from a LoggedIn function that first checks if you are actually logged into a site, if not this LogIn function should then be called and then the LoggedIn function called again to confirm you are now logged into the site.
- Public Function LogIn(ByVal site As String)
- Select Case site
-
- ' Log into google
- Case "google"
-
- 'Navigate IE to site
- Call NavigateTo("https://accounts.google.com")
-
- 'Login with UN & PASS
- Call NavigateHTML("input", "name", "Email", "myUsername")
- Call NavigateHTML("input", "name", "Passwd", "myPass")
- Call NavigateHTML("input", "value", "Sign in", "")
-
- ' Log into facebook
- Case "facebook"
-
- 'Navigate IE to site
- Call NavigateTo("https://www.facebook.com/")
-
-
- 'Login with UN & PASS
- Call NavigateHTML("input", "name", "email", "myUsername")
- Call NavigateHTML("input", "name", "password", "myPass")
- Call NavigateHTML("input", "value", "Log in", "")
-
-
- ' Log into example site
- Case "example"
-
- 'Navigate IE to site
- Call NavigateTo("http://www.example.org/")
-
-
- 'Login with UN & PASS
- Call NavigateHTML("input", "name", "USER", "myUsername")
- Call NavigateHTML("Input", "name", "PASSWORD", "myPass")
- Call NavigateHTML("Input", "value", "LogIn", "")
-
- 'Accept Computer Misuse Act
- Call NavigateHTML("input", "src", "/confirm.gif", "")
-
- 'Accept terms and conditions of website use
- Call NavigateHTML("input", "type", "checkbox", "accepttandc")
- Call NavigateHTML("input", "value", "Submit", "")
-
- 'Select portal hyperlink
- Call NavigateHTML("a", "href", "Notice portal", "")
-
- 'Enter pin and click gif input.
- Call NavigateHTML("input", "name", "pin", "1234")
- Call NavigateHTML("input", "src", "/content/skins/roll.gif", "")
-
- End Select
-
- Do While IE.Busy = True
- 'Animate Progress bar DoEvents()
- Loop
-
- LogIn = "True"
- End Function
-
-
-
-
- Public Function NavigateTo(ByVal site As String)
-
- With IE
- .Navigate (site)
- Do While .Busy = True
- 'Animate Progress bar
- Loop
- End With
-
- Set HTMLDoc = IE.Document
- Do While HTMLDoc.ReadyState <> "complete"
- Loop
-
- Set iHTMLCol = Nothing
- While iHTMLCol Is Nothing
- Set iHTMLCol = HTMLDoc.all.tags("input")
- Wend
-
- End Function
- Function CircuitIDIs(ByVal CircuitID As String)
-
- Dim ValidateItRtn As String
- ValidateItRtn = "NoMatch"
-
- Dim Regex As Object
- Set Regex = CreateObject("vbscript.regexp")
- Regex.IgnoreCase = True
- Regex.Global = True
-
- Regex.Pattern = "^([0]\d{9,10})$"
- If (Regex.test(CircuitID)) Then ValidateItRtn = "DN"
-
- Regex.Pattern = "^\D{4}\d{7}$"
- If (Regex.test(CircuitID)) Then ValidateItRtn = "SMPFID"
-
- Regex.Pattern = "^(CBUK\d{6}|CBUK\d{8})$"
- If (Regex.test(CircuitID)) Then ValidateItRtn = "CBUK"
-
-
- CircuitIDIs = ValidateItRtn
- End Function