Quick question I hope there is an easy answer.
I have a sub routine that navigates through a webpage. "Sub Navigate()"
Dim ie As Object
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
and so on.....
This part works fine and I successfully navigate through IE as needed. My next step comes from a separate sub routine "Sub copyimage()" I have designed where I pull images off the active page. However I cannot figure out how to use the open webpage for this.
The "Sub Copyimage()" sub works if I navigate directly to the URL within this sub. But I want to be able to get there from the work of my "Sub Navigate()" code.
I would like to be able to call the Copyimage() subroutine from the navigate() subroutine.
Please help
Here is full code from the first sub:
Sub FMSWebsite()
Dim strURL
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
strURL = "https://functionalmovement.com/login?return=%2F"
ie.Navigate strURL
ie.Visible = True
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
ie.Document.forms(0).all("Username").Value = Worksheets("Cover").Range("E8")
ie.Document.forms(0).all("Password").Value = Worksheets("Cover").Range("E10")
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
ie.Document.forms(0).submit
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Application.Wait (now + TimeValue("0:00:01"))
ie.Navigate ("http://functionalmovement.com/pro/clients")
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
ie.Document.forms(1).all("gvClients$DXFREditorcol1").Value = Worksheets("Template").Range("X2")
ie.Document.forms(1).all("gvClients$DXFREditorcol1").Select
SendKeys String:="{enter}", Wait:=True
Application.Wait (now + TimeValue("0:00:03"))
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Dim e
For Each e In ie.Document.getElementsByTagName("strong")
If e.innerText = "Client Workouts" Then
e.ParentElement.Click
Exit For
End If
Next
Application.Wait (now + TimeValue("0:00:01"))
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
For Each e In ie.Document.getElementsByTagName("span")
If e.innerText = "Create a New Workout" Then
e.ParentElement.Click
Exit For
End If
Next
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Application.Wait (now + TimeValue("0:00:01"))
For Each e In ie.Document.getElementsByTagName("span")
If e.innerText = "NEXT" Then
e.ParentElement.Click
Exit For
End If
Next
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Application.Wait (now + TimeValue("0:00:01"))
Set goBtn = ie.Document.getElementById("newscreen")
goBtn.Click
Application.Wait (now + TimeValue("0:00:01"))
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Fast Forward some code it ends like so:
For Each e In ie.Document.getElementsByTagName("span")
If e.innerText = "Complete" Then
e.ParentElement.Click
Exit For
End If
Next
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
Application.Wait (now + TimeValue("0:00:03"))
Do While (ie.Busy Or ie.READYSTATE <> 4)
DoEvents
Loop
For Each e In ie.Document.getElementsByTagName("span")
If e.innerText = "View Assigned Workout" Then
e.ParentElement.Click
Exit For
End If
Next
End Sub
My next sub starts with
Sub findimageA ()
For Each Elem In ie.Document.getElementsByTagName("img")
If Elem.getAttribute("title") = "Step 1" Then
How do I reference the web address I ended with in the first sub?
I believe you have in Navigate() something like:
Dim ieDocument as Object
which represent a web page (web document). If so, you need to create Copyimage() subroutine with argument, like this:
Sub Copyimage(ieDocImages as object)
and call this sub from previous one passing document (ieDocument) as a parameter:
Call Copyimage(ieDocument)
or do something similar depending of variables you use.
EDIT, based on additional code in question
First sub- add the following line before End Sub or before you terminate ie object:
Call findimagA(ie.Document)
and change the second sub as follows:
Sub findimageA(ieDocument As Object)
For Each Elem In ieDocument.getElementsByTagName("img")
Not tested but I'm sure it is ok.
Related
I need help with my script please. I am new to VBA and I have written the below code to load an intranet web page and login. After login, the next step is to click on one of several buttons on the web page. I am however getting run-time error 91 from the last line of code in bold text below (IE1.document.getElementById("btnAddPerson").Click).
Could you tell me what is wrong here please?
Thanks.
Regards
Michael T
Public Declare Function SetForegroundWindow Lib "user32" (ByVal HWND As Long) As Long
Option Explicit
Private Declare Function ShowWindow _
Lib "user32" _
(ByVal HWND As Long, _
ByVal nCmdShow As Long) _
As Long
Function IEWindowFromTitle(sTitle As String) As SHDocVw.InternetExplorer
Dim objShellWindows As New SHDocVw.ShellWindows
Dim win As Object, rv As SHDocVw.InternetExplorer
For Each win In objShellWindows
If TypeName(win.document) = "HTMLDocument" Then
If UCase(win.document.Title) = UCase(sTitle) Then
Set rv = win
Exit For
End If
End If
Next
Set IEWindowFromTitle = rv
End Function
Sub Test1()
'Login into IE
Dim IE As Object
Dim IE1 As Object
Dim doc As HTMLDocument
Dim btn As HTMLButtonElement
Dim MyHTML_Element As IHTMLElement
Dim MyHTML_Element1 As IHTMLElement
Set IE = CreateObject("InternetExplorer.Application")
Set IE1 = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "https://some_intranet_url/1"
Do While IE.Busy
ShowWindow IE.HWND, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
doc.getElementById("username").Value = "some_username"
doc.getElementById("password").Value = "some_password"
'Click to Login
For Each MyHTML_Element In doc.getElementById("loginForm")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
Do While IE.Busy
ShowWindow IE.HWND, 3
Application.Wait DateAdd("s", 1, Now)
Loop
'Selct role
doc.getElementById("selectedRole").Value = "555885740104"
'Click to Login
doc.getElementById("button1").Click
'Click to add person
Do While IE.Busy
' ShowWindow IE.HWND, 3
Application.Wait DateAdd("s", 1, Now)
'Set page to be fully loaded
Loop
Do While IE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
IE1.Visible = True
IE1.navigate "https://some_intranet_url/2"
Do While IE1.Busy
ShowWindow IE1.HWND, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Do While IE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
**IE1.document.getElementById("btnAddPerson").Click**
End Sub
Based on your code, I have created a sample using the following code, it works well on my side, you could also check it.
Function IEWindowFromTitle(sTitle As String) As SHDocVw.InternetExplorer
Dim objShellWindows As New SHDocVw.ShellWindows
Dim win As Object, rv As SHDocVw.InternetExplorer
For Each win In objShellWindows
If TypeName(win.Document) = "HTMLDocument" Then
If UCase(win.Document.Title) = UCase(sTitle) Then
Set rv = win
Exit For
End If
End If
Next
Set IEWindowFromTitle = rv
End Function
Sub Test1()
'Login into IE
Dim IE As Object
Dim IE1 As Object
Dim doc As HTMLDocument
Dim btn As HTMLButtonElement
Dim MyHTML_Element As IHTMLElement
Dim MyHTML_Element1 As IHTMLElement
Set IE = CreateObject("InternetExplorer.Application")
Set IE1 = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.google.com/"
Do While IE.Busy
'ShowWindow IE.Hwnd, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.Document
'Click to Login
Do While IE.Busy
'ShowWindow IE.Hwnd, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Do While IE.Busy
' ShowWindow IE.HWND, 3
Application.Wait DateAdd("s", 1, Now)
'Set page to be fully loaded
Loop
Do While IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
IE1.Visible = True
IE1.Navigate "https://www.bing.com/"
Do While IE1.Busy
'ShowWindow IE1.Hwnd, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Do While IE1.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
IE1.Document.getElementById("sb_form_q").Value = "vba"
IE1.Document.getElementById("sb_form_go").Click
End Sub
Since, I can't reproduce your problem, I suggest you could refer to the following steps to narrow down the problem, and try to solve it.
IE1.Visible = True
IE1.navigate "https://some_intranet_url/2"
Do While IE1.Busy
ShowWindow IE1.HWND, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Do While IE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
**IE1.document.getElementById("btnAddPerson").Click**
First, please check the above code, after navigating to another page, we should wait for the "IE1" instance complete, instead of the "IE" instance. Pleas try to modify the code as below:
IE1.Visible = True
IE1.Navigate "https://www.bing.com/"
Do While IE1.Busy
'ShowWindow IE1.Hwnd, 3
Application.Wait DateAdd("s", 1, Now)
Loop
Do While IE1.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Second, after navigation success, please check the focus window and use F12 developer tools to check the website resource, make sure you could find the "btnAddPerson" button.
Besides, here is an article about VBA Error 91, you could refer to it:
Object variable not set (Error 91)
For some reason I am not able to access elements inside iframe.
I have tried:
ie.Document.getElementById("sisaltosivu").contentDocument.getElementById("uusihaku")(0).Click
Here is my code:
Sub ChechAutomate()
Dim ie As New InternetExplorer, url As String, ws As Worksheet
Set ws = ThisWorkbook.Sheets("Other Data")
url = "https://www.asiakastieto.fi/data/atdb"
With ie
.Visible = True
.Navigate2 url
While .Busy Or .ReadyState < 4: DoEvents: Wend
With .Document
If .querySelectorAll("#btnb").Length > 0 Then
Else
.querySelector("[name=user1]").Value = "x"
.querySelector("[name=user2]").Value = "x"
.querySelector("[name=passwd]").Value = "x"
.querySelector("[class=btnb]").Click
Application.Wait (Now + TimeValue("00:00:01"))
ie.Navigate2 "https://www.asiakastieto.fi/sopimusasiakas/kotimaa?lang=FI"
Application.Wait (Now + TimeValue("00:00:01"))
ie.Document.getElementById("sisaltosivu").contentDocument.getElementById("uusihaku")(0).Click
End If
End With
End With
End Sub
You are no longer outside the iframe when you navigate to the src of the iframe. This line:
ie.Navigate2 "https://www.asiakastieto.fi/sopimusasiakas/kotimaa?lang=FI"
should mean you are now in the document referenced within the iframe and should access direct with:
.document.getElementById("uusihaku")(0).Click
I have a problem when trying to scrape data from website. It is Run-time error '424': Object required
My code:
Option Explicit
Sub GetData()
Dim IE As New SHDocVw.InternetExplorer
IE.Visible = True
IE.Navigate "abc.com"
Do While IE.ReadyState <> READYSTATE_COMPLETE
Loop
IE.Document.forms("vinSearchForm").elements("vin").Value =
"******"
IE.Document.forms("vinSearchForm").elements("vinSearch").Click
Sheets("Sheet1").Select
Range("A10").Select
IE.Document.forms("vinSummaryForm").elements
("test_vinSummary_carSpecification_$4").Value = Range("A10").Value
End Sub
What I want is that to show result "2004*********" in Range("A10").
Pls kindly help me accordingly. Thanks.
Although not the best way but should work for you
Option Explicit
Sub Autocheck()
Dim IE As New SHDocVw.InternetExplorer
IE.Visible = True
IE.Navigate "Autocheck.com"
Do While IE.ReadyState <> READYSTATE_COMPLETE Or IE.Busy
DoEvents
Loop
Application.Wait Now + TimeSerial(0, 0, 5)
IE.Document.forms("vinSearchForm").elements("vin").Value = "JTDKB22U140021007"
IE.Document.forms("vinSearchForm").elements("vinSearch").Click
Do While IE.ReadyState <> READYSTATE_COMPLETE Or IE.Busy
DoEvents
Loop
Application.Wait Now + TimeSerial(0, 0, 5)
Range("A10").Value = Split(IE.Document.getelementbyid("test_vinSummary_carSpecification_$4").innerText, vbNewLine)(1)
IE.Quit
Set IE = Nothing
End Sub
I need to extract URL's that contain specific line of the URL such as /example/example1/newexample/
<a onfocus="OnLink(this)" href="/example/example1/newexample/testing.aspx">Testing</a>
My current code returns all hyperlinks on the page. How do i only extract those links with just /example/example1/newexample/
Sub GetAllLinks()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
url_name = Sheet1.Range("B2")
If url_name = "" Then Exit Sub
IE.navigate (url_name)
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set AllHyperlinks = IE.document.getElementsByTagName("A")
Sheet1.ListBox1.Clear
For Each Hyperlink In AllHyperlinks
Sheet1.ListBox1.AddItem (Hyperlink)
Next
IE.Quit
MsgBox "Completed"
End Sub
See below
For Each Hyperlink In AllHyperlinks
If InStr(1, Hyperlink, "/example/example1/newexample/", vbTextCompare) > 0 Then
Sheet1.ListBox1.AddItem (Hyperlink)
End If
Next
Also, you need to change
Loop Until IE.readyState = READYSTATE_COMPLETE to Loop Until IE.readyState <> READYSTATE_COMPLETE
Use:
Sub GetAllLinks(byval filter as string)
Dim IE As Object
Dim url_name As String
Set IE = CreateObject("InternetExplorer.Application")
url_name = Sheet1.Range("B2")
If url_name = "" Then Exit Sub
IE.navigate (url_name)
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear
For Each Hyperlink In AllHyperlinks
If InStr(Hyperlink.href, filter) > 0 Then
Sheet1.ListBox1.AddItem (Hyperlink)
end if
Next
IE.Quit
MsgBox "Completed"
End Sub
filter ist your string. So use it like this:
call GetAllLinks("/example/example1/newexample/")
btw it would be a good idea to use
Option Explicit
and define your variables.
Easier to avoid initial loop and target with CSS selector and then loop the returned nodeList
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelector("a[href^='/example/example1/newexample/']")
For i = 0 To aNodeList.Length-1
Debug.print aNodeList.item(i).getAttribute("href")
Next i
The ^ means starts with so a[href^='/example/example1/newexample/'] is looking for elements with a tag containing attribute href starting with '/example/example1/newexample/'
Here is the CSS selector in action on your html sample:
Hi I'm trying to dynamically create a web browser inside a spreadsheet and then use it but the WebBrowser functions don’t seem to work
Here is how I create the WebBrowser
Set myWebBrowser = Sheets("test").OLEObjects.Add(ClassType:="Shell.Explorer.2", Link:=False, DisplayAsIcon:=False, left:=147, top:=60.75, width:=141, height:=96)
This will work
myWebBrowser.top = 10
But this will give me an error
myWebBrowser.Navigate ("about:blank")
Any ideas on what should I do thank you
UPDATE:
This will also don't work and give an error:
myWebBrowser.Object.Document.body.Scroll = "no"
myWebBrowser.Object.Silent = True
myWebBrowser.Object.Navigate ("about:blank")
While myWebBrowser.Object.ReadyState <> READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:01"))
Wend
myWebBrowser.Object.Refresh
UPDATE 2 (almost there):
Now I need a way to remove the Sheet2.Activate Sheet1.Activate
Sheet2.Activate
Sheet1.Activate
Set wb = myWebBrowser.Object
With wb
.Silent = True
.Navigate "about:blank"
Do While .ReadyState <> READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:01"))
Loop
.Document.Open "text/html"
Do While .ReadyState <> READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:01"))
Loop
.Document.write html
.Document.Close
.Document.body.Scroll = "no"
.Refresh
Debug.Print .Document.body.innerHTML
End With
myWebBrowser.Object.Navigate "http://www.google.com"
more complete example:
Sub AddWebBroswerToWorksheet()
Dim myWebBrowser
Dim wb, doc, x As Long
Sheet2.Activate
Sheet1.OLEObjects(1).Delete
Set myWebBrowser = Sheet1.OLEObjects.Add(ClassType:="Shell.Explorer.2", _
Left:=147, Top:=60.75, Width:=400, Height:=400)
Set wb = myWebBrowser.Object
With wb
.Navigate "about:blank"
.Document.Open "text/html"
For x = 1 To 100
.Document.write "hello world<br>"
Next x
.Document.Close
.Document.body.Scroll = "no"
Debug.Print .Document.body.innerHTML
End With
Sheet1.Activate 'switching back to the sheet seems to
' ' trigger the display of the object
End Sub
You need to pump Windows messages inside your WebBrowser.ReadyState <> READYSTATE_COMPLETE loop for this to work. Calling DoEvents/Sleep inside the loops does that, but has its own implications. Check these answers for further details and sample code:
https://stackoverflow.com/a/19019200/1768303
https://stackoverflow.com/a/19308865/1768303