I'm trying to run the below user defined function, but I receive the following error:
object variable or with block variable not set
Private Function Find_Select_Option(selectElement As HTMLSelectElement, optionText As String) As Integer
Dim i As Integer
Find_Select_Option = -1
i = 0
While i < selectElement.Options.length And Find_Select_Option = -1 ' ### error occurs on this line
DoEvents
If LCase(Trim(selectElement.Item(i).Text)) = LCase(Trim(optionText)) Then Find_Select_Option = i
i = i + 1
Wend
End Function
I have attached the VBA code below (source). Please go through it and let me know, what's wrong in this code.
Public Sub IE1()
Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
URL = "http://douglasne.mapping-online.com/DouglasCoNe/static/valuation.jsp"
Set IE = New InternetExplorer
With IE
.Visible = True
.navigate URL
While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set HTMLdoc = .document
End With
'<select name="StreetDir">
Dim optionIndex As Integer
Dim dirSelect As HTMLSelectElement
Set dirSelect = HTMLdoc.getElementsByName("StreetDir")(0)
'dirSelect.selectedIndex = 2 'set option index directly
optionIndex = Find_Select_Option(dirSelect, "E")
If optionIndex >= 0 Then
dirSelect.selectedIndex = optionIndex
End If
'<select name="StreetSfx">
Dim suffixSelect As HTMLSelectElement
Set suffixSelect = HTMLdoc.getElementsByName("StreetSfx")(0)
optionIndex = Find_Select_Option(suffixSelect, "PLAZA")
If optionIndex >= 0 Then
suffixSelect.selectedIndex = optionIndex
End If
End Sub
How can I fix this?
When I was poking around I also saw the OzGrid post you're pulling from. The problem is that the test URL, http://douglasne.mapping-online.com/DouglasCoNe/static/valuation.jsp, no longer has the elements you are looking for! For example, it does not have <select name="StreetDir">. So dirSelect is Nothing at the time you call Find_Select_Option.
I recommend testing with a local file. For example, create c:\users\prashant\foo.htm (or wherever you want to put it) with the following contents (modified from w3schools):
<!DOCTYPE html>
<html>
<body>
<select name="Car">
<option value="volvo">Volvo</option>
<option value="saab">Saab</option>
<option value="opel">Opel</option>
<option value="audi">Audi</option>
</select>
</body>
</html>
Then the following code should work (it does for me):
Public Sub IE1()
Dim URL As String
Dim IE As SHDocVw.InternetExplorer
Dim HTMLdoc As MSHTML.HTMLDocument
URL = "c:\users\prashant\foo.htm" ' *** Read from a local file
Set IE = New InternetExplorer
With IE
.Visible = True
.navigate URL
While .Busy Or .ReadyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set HTMLdoc = .document
End With
'<select name="Car">
Dim optionIndex As Integer
Dim dirSelect As HTMLSelectElement
Dim message As String
Set dirSelect = Nothing ' *** Set up for the error checking below
On Error Resume Next
'Set dirSelect = HTMLdoc.getElementsByTagName("select").Item(0) ' This is OK, too
Set dirSelect = HTMLdoc.getElementsByName("Car").Item(0) ' *** It exists!
' *** Here's some error-checking code you can use
If Err.Number <> 0 Then ' Report errors
message = "Error " & CStr(Err.Number) & vbCrLf & Err.Description
ElseIf dirSelect Is Nothing Then
message = "No element found"
Else
message = "OK" & vbCrLf & dirSelect.textContent
End If
On Error GoTo 0 ' *** Back to normal
MsgBox message
End Sub
When the parameter to getElementsByName is "Car", I get an OK response. When I change that parameter to "Nonexistent", I get No element found. This confirms that dirSelect is Nothing in your code at the point you call Find_Select_Option.
Related
I found this VBA code online and it works on Facebook for example.
On https://www.solarmanpv.com/portal/LoginPage.aspx it does not work. It opens Internet Explorer, puts the credentials on the right places but won't press login.
Error '424' is shown on VBA when I try to run.
Sub LoginViaBrowser()
Dim Dc_Usuario As String
Dim Dc_Senha As String
Dim Dc_URL As String
Dim objIE As New InternetExplorer 'Referencie "Microsoft Internet Controls"
objIE.Visible = True
Dc_Usuario = "user#email.com"
Dc_Senha = "pass"
Dc_URL = "https://www.solarmanpv.com/portal/LoginPage.aspx"
objIE.Navigate2 Dc_URL
Do Until objIE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
objIE.document.all("uNam").innertext = Dc_Usuario
objIE.document.all("uPwd").innertext = Dc_Senha
objIE.document.all("login").submit
End Sub
Please try to use F12 developer tools to check the html elements, then, you could find that the id of the login button is "Loginning", not "login".
Try to modify your code as below:
Sub LoginViaBrowser()
Dim IE As Object
Dim Dc_Usuario As String
Dim Dc_Senha As String
Dim Dc_URL As String
Dim txtNam As Object, txtPwd As Object
Dc_Usuario = "user#email.com"
Dc_Senha = "pass"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://www.solarmanpv.com/portal/LoginPage.aspx"
While IE.ReadyState <> 4
DoEvents
Wend
IE.Document.getElementById("uNam").Value = Dc_Usuario
IE.Document.getElementById("uPwd").Value = Dc_Senha
IE.Document.getElementById("Loginning").Click
End With
Set IE = Nothing
End Sub
Have you tried calling a click on it by id?
IE.Document.getElementById("Loginning").Click
I am trying to write a VBA script to input keywords (For expamle: Amuse) into the following website's textbox "Map Positioning" and click "go" to search the place automatically.
CentaMap
Here is the html script I found for the textbox
<INPUT onkeyup=searchBoxTextChanged(this.value); id=qbyid style="FONT-SIZE: 10pt" maxLength=60 name=q autocomplete="off">
Knowing that the normal way to do is to use get element by id then input such data in it. However I am being stuck as I cannot get the textbox element with the following codes:
Sub SubCentalineAutomation()
Dim myIE As InternetExplorer
Const url As String = "http://hk.centamap.com/gc/home.aspx?lg=en"
Set myIE = New InternetExplorer
myIE.navigate (url)
Do While myIE.readyState <> 4
DoEvents
Loop
myIE.Visible = True
myIE.document.getElementsByName("q")(0).Value = "Amuse"
End Sub
I tried to replace the codes by using getElementsById("qbyid") instead however VBA cannot find the element too.
Can anybody help on this?
Needs Reference to
Microsoft Internet Controls
Microsoft HTML Object Library
Sub SubCentalineAutomation()
Dim myIE As InternetExplorer
Dim frame As MSHTML.HTMLFrameElement
Dim inp As MSHTML.HTMLInputElement
Const url As String = "http://hk.centamap.com/gc/home.aspx?lg=en"
Set myIE = New InternetExplorer
myIE.navigate (url)
Do While myIE.readyState <> 4
DoEvents
Loop
myIE.Visible = True
Set frame = myIE.document.getElementsByName("search")(0)
Set inp = frame.contentDocument.getElementsByName("q")(0)
inp.Value = "Amaze"
End Sub
try getElementById("qbyid"), not getElementsById("qbyid")
If you simply want the suggestion, without the map navigation you can use:
Option Explicit
Public Sub GetInfo()
Dim sResponse As String, html As New HTMLDocument, searchTerm As String
searchTerm = "Amuse"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://hk.centamap.com/gsearch/paddresssearch1.aspx?lg=en&search=" & searchTerm & "&ck=gbase&ft2=", False
.send
sResponse = StrConv(.responseBody, vbUnicode)
sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))
With html
.body.innerHTML = sResponse
Debug.Print html.querySelector("a").innerText
End With
End With
End Sub
If you want to enter a value and then navigate to the first returned suggestion:
Option Explicit
Public Sub SubCentalineAutomation()
Dim myIE As InternetExplorer, html As New MSHTML.HTMLDocument, frame As MSHTML.HTMLFrameElement, form As MSHTML.HTMLFormElement
Const URL As String = "http://hk.centamap.com/gc/home.aspx?lg=en"
Set myIE = New InternetExplorer
With myIE
.navigate URL
.Visible = True
While .Busy Or .readyState < 4: DoEvents: Wend
Set html = .document
Set frame = html.getElementsByTagName("frame")(1)
Set form = frame.contentDocument.getElementsByTagName("form")(0)
form.getElementsByTagName("input")(1).Value = "Amuse"
form.getElementsByTagName("input")(2).Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set frame = .document.getElementsByTagName("frame")(4)
Set frame = frame.contentDocument.getElementsByTagName("iframe")(0)
frame.contentDocument.getElementsByTagName("table")(0).getElementsByTagName("a")(0).Click
'.Quit '<== Remember to quit application
End With
End Sub
How can I get a specific element of a determined webpage to display it in excel WebBrowser as example like <img> or <iframe> or <audio> or <a> ... etc.
I know how to display an image if it is not a part of webpage like the following.
WebBrowser1.Navigate "about:blank"
WebBrowser1.Document.Write "<img style=""width:100%;"" src=""http://www.sthua.edu.sg/images/vba-logo.jpg"">"
but I don't know how to get an element by id or class name from any webpage.
Here is an example showing how to retrieve class="gt-baf-table" element from the webpage translate.google.com.eg, and put it into WebBrowser1 control on the UserForm1:
Option Explicit
Sub Test()
Dim objIE As Object
Dim objNode As Object
Dim objTable As Object
Dim strHtmlContent As String
Dim colSSheets As Object
Dim objSSContent As Object
Dim varSSheet
Dim objWB As Object
Dim objHead As Object
Dim varCssNumber
' instantiate IE, navigate and get target DOM element
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True ' for debug only
objIE.Navigate "https://translate.google.com.eg/?hl=ar&tab=wT#en/ar/boy"
Wait objIE
WaitElementById objIE, "gt-lc"
' retrieve HTML content
Set objNode = objIE.Document.GetElementById("gt-lc")
Set objTable = objNode.GetElementsByClassName("gt-baf-table")(0)
strHtmlContent = objTable.outerHTML
strHtmlContent = "<body dir=rtl>" & strHtmlContent & "</body>"
' retrieve CSS content
Set colSSheets = objIE.Document.styleSheets
Set objSSContent = CreateObject("Scripting.Dictionary")
For Each varSSheet In colSSheets
objSSContent(objSSContent.Count) = varSSheet.cssText
Next
objIE.Quit
' Init UserForm, WebBrowser
UserForm1.Show
Set objWB = UserForm1.WebBrowser1
objWB.Navigate "about:blank"
Wait objWB
' put HTML and CSS content into WebBrowser
With objWB.Document
.Write strHtmlContent
Set objHead = .GetElementsByTagName("head")(0)
For Each varCssNumber In objSSContent
objHead.appendChild .createElement("style")
.styleSheets(.styleSheets.Length - 1).cssText = objSSContent(varCssNumber)
Next
End With
End Sub
Sub Wait(objIE)
Do While objIE.ReadyState < 4 Or objIE.Busy
DoEvents
Loop
Do Until objIE.Document.ReadyState = "complete"
DoEvents
Loop
End Sub
Sub WaitElementById(objIE, strId)
Do While IsNull(objIE.Document.GetElementById(strId))
DoEvents
Loop
End Sub
The resulting output on the UserForm1 is as follows:
And the same fragment rendered in Chrome:
I recently came across a new problem while working with my Excel VBA code in order to automate the input a value from a cell (order number) into Amazon's search box and searching for the order. I can't seem to locate the proper object to reference the search button on the homepage of the Amazon Seller home page in order to click and proceed. My code is this:
Option Explicit
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub MyAmazonSeller()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim oSignInLink As HTMLLinkElement
Dim oInputEmail As HTMLInputElement
Dim oInputPassword As HTMLInputElement
Dim oInputSigninButton As HTMLInputButtonElement
Dim oInputSearchOrder As HTMLInputElement
Dim oInputSearchButton As HTMLInputButtonElement
MyURL = "https://sellercentral.amazon.com/gp/homepage.html"
Set MyBrowser = New InternetExplorer
' Open the browser and navigate.
With MyBrowser
.Silent = True
.Navigate MyURL
.Visible = True
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
End With
' Get the html document.
Set HTMLDoc = MyBrowser.Document
' See if you have the sign in link is because you are in the main
' page
Set oSignInLink = HTMLDoc.getElementById("signin-button-container")
If Not oSignInLink Is Nothing Then
oSignInLink.Click
Do
DoEvents
Loop Until MyBrowser.ReadyState = READYSTATE_COMPLETE
End If
' Get the email field and the next button
Set oInputEmail = HTMLDoc.getElementById("username")
Set oInputPassword = HTMLDoc.getElementById("password")
' Click the button and wait
oInputEmail.Value = "xxxxxxxxx#xxxxxx.net"
' Get the password field and the sign in button
Set oInputPassword = HTMLDoc.getElementById("password")
Set oInputSigninButton = HTMLDoc.getElementById("sign-in-button")
' Click the button and wait
oInputPassword.Value = "xxxxxxxx"
oInputSigninButton.Click
Do
DoEvents
Loop Until MyBrowser.ReadyState = READYSTATE_COMPLETE
Set oInputSearchOrder = HTMLDoc.getElementById("sc-search-field")
oInputSearchOrder.Value = "110-7706193-5695453"
Set oInputSearchButton = HTMLDoc.getElementByClassName("sc-search-button")
oInputSearchButton.Click
Do
DoEvents
Loop Until MyBrowser.ReadyState = READYSTATE_COMPLETE
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
The section right before the Err_Clear is the new snippet of code I've been trying to modify and work with. It seems that the search button does not have a proper ID, so therefore is more difficult to reference. I am getting an Error 91 every time the code gets to the second to last snippet.
I am trying to automate a process where I must query a website: http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset
There is a input text field <input name="query size="20"/>" that I want to populate but I am struggling to do so. Currently I am testing my code to see if I can even reference the tag.
Sub fill()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset"
IE.Visible = True
While IE.busy
DoEvents
Wend
For Each it In IE.Document.getElementsByTagName("input")
If it.Name = "newquery" Then
MsgBox ("yup")
End If
Next
End Sub
I think my issue is that the input field is in 2 framesets and a frame...
Any ideas if this is even possible to do?
Unless you know exactly which frame the input is in, this is a classical situation for a recursive search:
Sub fill()
Dim IE As Object, elem As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset"
IE.Visible = True
While IE.Busy: DoEvents: Wend
While IE.document.readyState <> "complete": DoEvents: Wend
Set elem = FindInputByName(IE.document, "newquery")
If Not elem Is Nothing Then
elem.Value = "It works!"
End If
End Sub
Function FindInputByName(document As Object, name As String) As Object
Dim i As Integer, subdocument As Object, elem As Variant
Set FindInputByName = Nothing
For i = 0 To document.frames.Length - 1
Set subdocument = document.frames.Item(i).document
Set FindInputByName = FindInputByName(subdocument, name)
If Not FindInputByName Is Nothing Then Exit Function
Next i
For Each elem In document.getElementsByTagName("INPUT")
If elem.name = name Then
Set FindInputByName = elem
Exit Function
End If
Next elem
End Function
You should try to install and use opentwebst Library : http://codecentrix.com/download.html
Don't forget to add opentwebst in project references.
It took me less time to generate the code below then writing this post :
Sub OpenTwebstMacro
Dim core As ICore
Set core = New OpenTwebstLib.core
Dim browser As IBrowser
Set browser = core.StartBrowser("http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset")
Call browser.FindElement("input text", "name=newquery").InputText("YOUR QUERY")
Call browser.FindElement("input button", "uiname=Go").Click
End Sub