I am trying to capture data from Url with Query Selector getting some error . as I am not an expert on vba. please someone can help me solve this here I enclosed my code
Public Sub CommandButton1_Click()
'On Error Resume Next
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "https://g.page/shrungarbeauty?share" ' try with first URLS and second
Do
DoEvents
Loop Until ie.readystate <> 4
Application.Wait (Now + TimeValue("00:00:15"))
title As Object
Set title = ie.document.querySelector("section-hero-header-title-title GLOBAL__gm2-headline-5").innerText
ActiveCell = title
ie.Quit
Set ie = Nothing
End Sub
Related
Here i have given a dummy website, I'm using the below code to write something on the cell but i'm getting error "Run-time error '424': Object required".
I tried Facebook and it was working for me, Can this be resolved, I'm new to this VBA if someone can help me it will be very helpful.
Sub Test1()
Dim IE As Object
Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
IE.Visible = True
IE.navigate "https://company.com"
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
IE.document.getElementById("WD0367").Value = "A-1234"
End Sub
Tried using the above code and i was able to login to company website but information is not getting filled up and getting this error - Run-time error '424': Object required
The code worked in excel2007 and windows10. Don't work in windows 11
'declare inside a module in Modules
Public ie As SHDocVw.InternetExplorer
'this function is in a sheet's module
Public Function example(Url As String) As String
Dim objElement As Object
example = vbNullString
If ie Is Nothing Then
Set ie = CreateObject("InternetExplorer.Application")
End If
If ie Is Nothing Then Exit Function
ie.Navigate Url
Do While ie.Busy = True Or ie.ReadyState <> 4
DoEvents
'Application.Wait DateAdd("s", 1, Now)
Loop
If ie.LocationURL = Url Then 'instr(1,ie.LocationURL, Url) > 0 Then
Set objElement = ie.Document.all("username")
objElement.Value = Range("CC_USERNAME").Value2
Set objElement = ie.Document.all("password")
objElement.Value = SHEET_CODENAME.TextBox1.Value
ie.Document.forms(0).submit
Do While ie.Busy = True Or ie.ReadyState <> 4
DoEvents
Loop
'......YOUR CODE HERE
'......
example = ie.LocationURL
End If
Set objElement = Nothing
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not (ie Is Nothing) Then
ie.Quit
Set ie = Nothing
End If
End Sub
I am using the following code in vba to extract a value from a website.
Let's pretend the value is wrapped inside a html span id. i want to retrieve this value and display it as a message box in excel.
Here's my code:
Sub PullExpiry()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.brcdirectory.com/InternalSite//Site.aspx?BrcSiteCode=" & Range("J6").Value
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementsByClassName("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub
HTML:
<span id="ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate">Expiry Date : 16/02/2018</span>
I get an object doesn't support this property or method error:
IE.Document.getElementsByClassName("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
Please can someone show me where i am going wrong?
EDIT
Other code tried:
Sub PullExpiry()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.brcdirectory.com/InternalSite//Site.aspx?BrcSiteCode=" & Range("J6").Value
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
DoEvents
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementByID("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub
I have a short excel macro that is designed to:
1) Open Internet Explorer and navigate to "http://www.puco.ohio.gov/pucogis/address/search.cfm"
2) Fill out a form on that site with data from the excel workbook
3) Click a button to submit the form
4) Scrape some innertext from the website and place it in a cell in the workbook
5) Close Internet Explorer
I can not get step 3 to work. That is, I can not get the click/submit function to work with this website. When the button is clicked the website populates with information specific to the information entered in the form. Everything else in the code is working. I have searched for an answer and tried the submit verses click approach with no luck.
Thanks for you help.
Code below:
Private Sub SiteData()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
Set HTMLButton = ie.Document.getElementsByTagName("input")(1)
HTMLButton.Click
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D50") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
Try this solution, which I found from this answer to a similar question. That answer was not accepted, but I have tested this with your code and seems to be working.
Private Sub SiteData()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
Call ie.Document.parentWindow.execScript("codeAddress()")
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D50") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
If you don't know or can't reasonably anticipate the function call codeAddress(), then you can try something like this to derive it from the button's onclick property:
Dim fn$
fn = HTMLButton.onclick
fn = Mid(fn, InStr(fn, "{"))
fn = Trim(Replace(Replace(Replace(fn, "{", vbNullString), "}", vbNullString), vbLf, vbNullString))
Call ie.Document.parentWindow.execScript(fn)
You can call the JavaScript directly. try this it will work
Instead of:
Set HTMLButton = ie.Document.getElementsByTagName("input")(2)
HTMLButton.Click
use
ie.Document.parentWindow.execScript code:="codeAddress()"
note that IE may prompt you to confirm every run so you may need to
stop showing this message for smooth operation
Private Sub CommandButton1_Click()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
ie.Document.parentWindow.execScript code:="codeAddress()"
'Set HTMLButton = ie.Document.getElementsByTagName("input")(2)
'HTMLButton.Click
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D16") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
thanks also to this article helped me to solve your problem
How to find and call javascript method from vba
So I have some code to go to a website and then login. Then I need it to go to the password change URL. Sometimes when I run the code, I get the following error:
Runtime Error 424: Object Required
Sometimes the debugger says it is the first getelementbyid statement, but most times it says the issue is the last three getelementbyid statements. The code is below:
Dim ie As Variant
Dim strURL As String
Sub login()
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate "https://minecraft.net/profile"
While ie.Busy
DoEvents
Wend
ie.document.getElementById("username").Value = "ddd"
ie.document.getElementById("password").Value = "ddddddddddd"
Dim htmlForm As HTMLFormElement
Set htmlForm = ie.document.getElementById("loginForm")
htmlForm.submit
' **********************************************************************
'IE.Document.getElementById("username").Value = "ddddd"
' IE.Document.getElementById("password").Value = "ddddd"
' IE.Document.getElementById("signin").Click
'**********************************************************************
'Pause while page loads
Application.Wait (Now + #12:00:03 AM#)
ie.navigate "https://minecraft.net/profile/password"
ie.document.getElementById("oldPassword").Value = "oldpass"
ie.document.getElementById("password").Value = "enwapss"
ie.document.getElementById("passwordConfirmation").Value = "enwapss"
Set htmlForm = ie.document.getElementById("loginForm")
htmlForm.submit
End Sub
Thanks in advance!
It may be that the website isn't in a ready state, as in the site hasn't fully loaded when it's attempting to input the values.
After
ie.navigate "https://minecraft.net/profile/password"
Try adding
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
This will loop until the webpage has loaded similar, to the way you've done it in your above code with
Application.Wait (Now + #12:00:03 AM#)
I am a newbie in this website and in VBA programming as well. I am stuck into a problem where I have to fetch the data from this page. I need to have the hyperlink url of Check Rates 10 button. Can anyone help me with this problem.
I have done the following code:
Sub GetData()
Dim IE As New InternetExplorer
IE.navigate "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"
IE.Visible = False
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Dim doc As HTMLDocument 'variable for document or data which need to be extracted out of webpage
Set doc = IE.document
Dim dd As Variant
dd = doc.getElementsByClassName("lgn")(0).outerHtml
'Range("a1").Value = dd
MsgBox dd
End Sub
In which I am getting text of the button but I want to have the value of the class. I think I am very close to the result but somehow cant reach to the goal...can anyone please help me...
Regards,
I think this is what you're looking for:
(Code modified slightly from Kyle's answer here)
Sub Test()
'Must have the Microsoft HTML Object Library reference enabled
Dim oHtml As HTMLDocument
Dim oElement As Object
Dim link As String
Set oHtml = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345", False
.Send
oHtml.Body.innerHTML = .responseText
End With
If InStr(1, oHtml.getElementsByClassName("lgn")(0).innerText, "Bekijk 10 prijzen") > 0 Then
link = Mid(oHtml.getElementsByClassName("lgn")(0).href, 7)
Debug.Print "http://www.kieskeurig.nl" & link
End If
End Sub
This code prints the URL to the immediate window. Hope that helps!
This works for me...
Sub GetData()
Set IE = CreateObject("InternetExplorer.Application")
my_url = "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"
With IE
.Visible = True
.navigate my_url
.Top = 50
.Left = 530
.Height = 400
.Width = 400
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
End With
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Set Results = IE.document.getElementsByTagName("a")
For Each itm In Results
If itm.classname = "lgn" Then
dd = itm.getAttribute("href")
Exit For
End If
Next
' if you wnat to click the link
itm.Click
' otherwise
'Range("a1").Value = dd
MsgBox dd
End Sub