VBA check if HTMLDivElement exists on page before proceeding - vba

Set doc = ie.document
**Check Here for Data element**
Set fname = doc.getElementById("data")
I want to verify that the Element "data" actually exists before to setting the variable = to it.
would an if work and how would I structure the if to look at doc and verify that the element "data" exists
doc is declared as HTMLDocument
fname is declared as HTMLDivElement

This is how you'd typically do it:
Set doc = ie.document
Set fname = doc.getElementById("data")
If fname is nothing then
'was not found on the page
else
'found
end if

Related

Get an element by name and set its value

Sub FlashReportAutomation()
Dim web As Object
Dim doc As HTMLDocument
Set web = CreateObject("internetexplorer.application")
web.Visible = True
web.navigate "http://google.com"
Do While web.Busy
Application.Wait DateAdd("s", 2, Now)
Loop
Set doc = web.Document
web.Document.getElementsByName("q").Value = "Robert"
End Sub
I'm unable to get this working, if element ID is not mentioned. Any help?
I agree with the suggestion given by Tim Williams regarding passing the index number for the element with the name 'Q'.
Another thing I noticed is that in the line below you have set the document object.
Set doc = web.Document
While assigning the value to the element, you are again using the document. It will generate an error.
web.Document.getElementsByName("q").Value = "Robert"
Your code should be like below.
Set doc = web.document
doc.getElementsByName("q")(0).Value = "Robert"
You could try like this and let us know if you have questions.

VBA + IE Automation - can't get Element ID

I am trying to scrape some information from an internal company website. My code is able to launch a new IE window and navigate successfully to the page but when I try and input data into a box I keep getting errors.
I've switched various things around based off the posts i've read but always get some sort of error.
For the code posted below it's this error on the last line:
Object Variable or With Block Not Set
Here is my code:
Sub PerformancePull()
Dim appIE As Object
Dim sURL As String
Dim StartDate As Variant
Dim MyDoc As HTMLDocument
Set appIE = New InternetExplorerMedium
sURL = "website"
With appIE
.navigate sURL
.Visible = True
End With
Do While appIE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set MyDoc = appIE.document
Set StartDate = MyDoc.getElementById("ct100_assoc_tbEndDate")
StartDate.Value = "3/25/2020"
End Sub
Edit:
Here's a piece of the HTML code that identifies the ID I'm trying to capture:
Try the following
Remove this
Set StartDate = MyDoc.getElementById("ct100_assoc_tbEndDate")
StartDate.Value = "3/25/2020"
And replace it with this
With MyDoc
.getElementById("ct100_assoc_tbEndDate").Value = "3/25/2020"
End With
I tried to test your code on my side and it worked fine without any error. Below is the testing result.
I suggest you try to access the element and assign the value like below to check whether it works or not.
appIE.document.getElementById("ct100_assoc_tbEndDate").Value = "3/25/2020"
Let us know about your testing results if the issue persists then we will try to provide further suggestions.

Excel Issue: Object Variable or with block Variable not set

I have a code that works for me about 70% of the time, the other times it throws the Error code 91 "Object Variable or With block Variable not set". If i click End and re-run it it will work fine.
The function is taking data that is entered into cells of an excel spreadsheet and populating text boxes, checking radio buttons, and selecting from drop-down lists on a webpage.
I can't post a link to the actual webpage for privacy issues but I'm hoping someone can help me why the error is coming up?
The line that shows the error is
drp.selectedIndex = Thisworkbook.sheets("sheet1").Range("L2").
Sub FillInternetForm()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
'set references for copying to submitted reps sheet and deleting for next rep
Application.ScreenUpdating = False
'create new instance of IE.
ie.navigate "removed for privacy"
'go to web page listed inside quotes
ie.Visible = True
While ie.busy
DoEvents 'wait until IE is done loading page.
Wend
'select onboarding system CRIS or ENS
Set html = ie.document
Dim drp As HTMLFormElement
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("L2")
'set address nickname based on value
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff32_1$ctl00 $Lookup")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("m2")
'set market based on value
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff6_1$ctl00$ DropDownChoice")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("e2")
'check Not moved from another partner
ie.document.getElementById("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff46_1_ctl00_ctl01").Click
'input name and ssn based on excel sheet values
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff3_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("a2")
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff4_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("b2")
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff5_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("c2")
'input extra fields based on ICL value
'owner
ie.document.all("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff11_1_ctl00_ctl00_TextField").Value = ThisWorkbook.Sheets("sheet1").Range("j2")
'city
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff14_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("f2")
'state
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff15_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("g2")
'address
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff13_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("i2")
'phone
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff10_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("k2")
'zip
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff16_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("h2")
End Sub
While ie.busy is probably to blame. Use Loop Until ie.readyState = READYSTATE_COMPLETE instead.
I would cast .Range("L2") as an integer using CInt(.Range("L2")). You have a reference to the HTML Object library set. You should go ahead and add a reference to Microsoft Internet Controls. This way you'll get advantages of intellisense and internet constants. If you don't want to set the reference add Const READYSTATE_COMPLETE = 4 to the code and change the ie references back
Sub FillInternetForm()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Set ie = New InternetExplorer
'set references for copying to submitted reps sheet and deleting for next rep
Application.ScreenUpdating = False
'create new instance of IE.
ie.navigate "removed for privacy"
'go to web page listed inside quotes
ie.Visible = True
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
With Sheets("sheet1")
'select onboarding system CRIS or ENS
Set doc = ie.document
Dim drp As HTMLFormElement
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))
'set address nickname based on value
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff32_1$ctl00 $Lookup")
drp.selectedIndex = CInt(.Range("m2"))
'set market based on value
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff6_1$ctl00$ DropDownChoice")
drp.selectedIndex = CInt(.Range("e2"))
'check Not moved from another partner
doc.getElementById("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff46_1_ctl00_ctl01").Click
'input name and ssn based on excel sheet values
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff3_1$ctl00$ctl00$TextField").value = .Range("a2")
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff4_1$ctl00$ctl00$TextField").value = .Range("b2")
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff5_1$ctl00$ctl00$TextField").value = .Range("c2")
'input extra fields based on ICL value
'owner
doc.all("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff11_1_ctl00_ctl00_TextField").value = .Range("j2")
'city
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff14_1$ctl00$ctl00$TextField").value = .Range("f2")
'state
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff15_1$ctl00$ctl00$TextField").value = .Range("g2")
'address
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff13_1$ctl00$ctl00$TextField").value = .Range("i2")
'phone
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff10_1$ctl00$ctl00$TextField").value = .Range("k2")
'zip
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff16_1$ctl00$ctl00$TextField").value = .Range("h2")
End With
End Sub
I agree with #Thomas Inzina in that it's probably because the document hasn't fully loaded yet.
But I've found with my past projects that the best way to handle these 30% failure rates is to just "wait a bit longer" before processing or referring to elements.
Try adding a DoEvents and a Sleep command before you selectedIndex call.
See if it makes a difference
At the top of your module (before any subs are declared)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then add the two lines before you start set the doc variable
Doevents
Sleep 2000 ' Sleep two seconds (2000 ms)
Set doc = ie.document
You can play with the sleep value once you get a number that works for you
EDIT - added solution
A more reliable way is to actually run a loop that has DoEvents/Sleep and an incrementing counter for numTries. It exits the loop only when the check for getElementById doesn't fail - or your maxTries counter is reached.
Pretty simple loop but let me know if you need an example
EDIT - EXAMPLE: A wait until loaded loop
Change this
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))
To this:
Dim iTries As Integer
Dim iMaxTries As Integer ' it's better to turn this into a const at top of your sub
iMaxTries = 3
iTries = 0
While (iTries < iMaxTries) And IsNull(HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice"))
iTries = iTries + 1
DoEvents
Sleep 750 ' try 3/4 second delays to start with
Wend
If iTries = iMaxTries Then
MsgBox "Did not load HTML element in " & iMaxTries & " tries"
Exit Sub
End If
' Should all be loaded and ready to process now
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))

VBA - Addressing Internet Explorer tabs

Strangely enough I didn't find any information on the topic and I'm currently stuck at the point where I managed to open a new tab in an instance of IE by programmatically clicking a button, but I haven't the faintest clue of how to address the new tab in order to get information from there (the button basically brings up a new tab with the result of a search).
This is basically a straightforward question, but I'm including my code anyway:
Sub AddInfoFromIntranet()
Dim Ie As SHDocVw.InternetExplorer
Dim URL As String
Dim iFrames As MSHTML.IHTMLElementCollection
Dim iFrame As MSHTML.HTMLFrameElement
Dim Doc As MSHTML.HTMLDocument
Dim InputBox As MSHTML.IHTMLElementCollection, htmlButton, allTags, Tag
' Opens Intranet - yeah, sadly it's not a public web page
URL = "{My intranet website}"
Set Ie = New SHDocVw.InternetExplorer
With Ie
.navigate URL
.Visible = True
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set Doc = .document
End With
' Gets top_window frame and navigates to it, then inserts the name to search
Set iFrames = Doc.getElementsByName("top_window")
If Not iFrames Is Nothing Then
Set iFrame = iFrames(0)
Ie.navigate URL & iFrame.src
While Ie.Busy Or Ie.readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set InputBox = Doc.getElementsByName("Nachnamevalue")
If Not InputBox Is Nothing Then InputBox(0).Value = "test"
' Clicks on "search"
Set allTags = Doc.getElementsByTagName("input")
For Each Tag In allTags
If Tag.Value = "suchen" Then
Tag.Click
Exit For
End If
Next
' Here a new tab is opened, must find info in this tab
While Ie.Busy Or Ie.readyState <> READYSTATE_COMPLETE: DoEvents: Wend
' HERE I HAVE NO CLUE WHAT TO WRITE. THE CODE ABOVE WORKS FLAWLESSLY
End If
Set Doc = Nothing
Set iFrames = Nothing
Set iFrame = Nothing
Set InputBox = Nothing
Set allTags = Nothing
Set Ie = Nothing
Ie.Quit
End Sub
Now, is there a way to address a tab by: 1) its name (and where do I find it) 2) its position in browser 3) the status (if it is "active") ?
Bonus questions: since I am new to VBA and Internet Explorer interaction, what exactly are the variables: htmlButton, allTags, Tag ? Also, could anyone explain if I need to set all the variables at the end to nothing, or I just need to set the Internet Explorer to nothing?
Thanks in advance!
See below for a function you can use to get an open IE document window - I don't think IE exposes any simple (VBA-accessible) API for working directly with tabs or determining whether a specific tab is active.
allTags is a collection of DOM elements with type "" , and Tag is a single memeber of that collection.
You do not have to set objects to Nothing before exiting a Sub (though some people still do that) - the VBA runtime will take care of that for you.
Sub TestGetIE()
Dim IE As Object
Set IE = GetIE("http://stackoverflow.com")
If Not IE Is Nothing Then
IE.document.execCommand "Print", False, 0
End If
End Sub
'Get a reference to an open IE window based on its URL
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
sURL = ""
On Error Resume Next
'check the URL and if it's the one you want then
' assign it to the return value
sURL = o.document.Location
On Error GoTo 0
'Debug.Print sURL
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function

Get ticker price within html class issue. Creating a stock ticker through InternetExplorer.application

I'm trying to create my own ticker price. Now I'm trying to get the ticker prices for indexes and trust funds which complicates things. I want to access the ticker price for the following url: https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r
Now the issue is getting to the 180,05 ( under "NAV-kurs" ) ticket price which is under the HTML class"SText bold" ( right-clicking price and selecting view component ).
I can do individual stocks through yahoo finance through getelementbyid but how do I access the innertext for a HTML-class? I can't find any property that works in connection to getelementbyclassname which I tried.
Code below
Private Sub get_ticker()
Dim ie_app As InternetExplorer
Dim ie_doc As htmldocument
Dim ticker As String
Set ie_app = CreateObject("internetexplorer.application")
ie_app.Visible = True
ie_app.navigate ("https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r")
Do Until ie_app.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set ie_doc = ie_app.document
ticker = ie_doc.getelement <<---- gaah
Debug.Print ticker
End Sub
If you are reluctant to use Javascript at all you can try something like that.
Note: this code relies on early binding and requires both the Microsoft XML (v6.0) and Microsoft HTML Object Library to be ticked in your references.
Sub getPrice()
Dim xhr As MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim XSText As MSHTML.IHTMLElementCollection
Dim elt As MSHTML.HTMLDivElement
Dim parentElt As MSHTML.HTMLLIElement
Dim myPrice As Single
Set xhr = New MSXML2.XMLHTTP60
With xhr
.Open "GET", "https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r", False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Else
MsgBox "xhr error"
Exit Sub
End If
End With
set xhr = Nothing
Set XSText = doc.getElementsByClassName("XSText")
For Each elt In XSText
If InStr(elt.innerHTML, "NAV SEK") <> 0 Then
Set parentElt = elt.parentElement
myPrice = CSng(parentElt.getElementsByClassName("SText bold")(0).innerHTML)
End If
Next
MsgBox myPrice
End Sub
Cheat - That page contains jQuery which is much nicer to use to select elements with no ID, E.g. tell it to look for a div of class XSText containing NAV SEK : div.XSText:contains('NAV SEK') and read the text of the next element:
...
Set ie_doc = ie_app.Document
''Create a new element in the document we can read from:
Dim tempInput As HTMLInputElement
Set tempInput = ie_doc.createElement("input")
tempInput.Type = "hidden"
tempInput.ID = "tempInput"
'' add it to the document
ie_doc.appendChild tempInput
'' use jQuery to lookup the value and assign it to the temp input
ie_doc.parentWindow.execScript("$('#tempInput').val($( ""div.XSText:contains('NAV SEK')"" ).next().text())")
'' read the value
msgbox tempInput.Value