How do I run an Internet Explorer application through WebBrowser? - excel

I've created this code that simulates my actual application. And I'm trying to run the procedure through WebBrowser1. If in my actual application it was possible to use .document.getElementById would work, but you need .getElementsByClassName or TagName. How could I do this with the data below?
The code application is executed by the CommandButton and the WebBrowser will be inside a Userform.
Private Sub CommandButton1_Click()
Dim IE As InternetExplorer
Dim iELE As Object
Dim xUser As String
Dim xPswd As String
Set IE = New InternetExplorer
IE.Visible = True
IE.Navigate ("https://twitter.com/login?lang=pt")
xUser = "your username"
xPswd = "your password"
Application.Wait (Now + TimeValue("0:00:10"))
Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
For Each iELE In IE.Document.getElementsByClassName("js-username-field email-input js-initial-focus")
If iELE.Value = "" Then
iELE.Value = xUser
End If
Exit For
Next
For Each iELE In IE.Document.getElementsByClassName("js-password-field")
If iELE.Value = "" Then
iELE.Value = xPswd
End If
Exit For
Next
Application.Wait (Now + TimeValue("0:00:05"))
For Each iELE In IE.Document.getElementsByClassName("submit EdgeButton EdgeButton--primary EdgeButtom--medium")
If iELE.Value = "" Then
iELE.Click
End If
Exit For
Next
End Sub

Try this
Sub Login(MyLogin, MyPass, strUrl)
Dim IeApp As InternetExplorer
Dim IeDoc As Object
Dim ieTable As Object
Set IeApp = New InternetExplorer
IeApp.Visible = False
IeApp.Navigate strUrl
Do While IeApp.Busy: DoEvents: Loop
Do Until IeApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set IeDoc = IeApp.Document
With IeDoc
.getElementsByClassName("js-username-field")(0).value = MyLogin
.getElementsByClassName("js-password-field")(0).value = MyPass
End With
IeDoc.getElementsByClassName("submit")(0).Click
Do While IeApp.Busy: DoEvents: Loop
Do Until IeApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
End Sub
https://www.pk-anexcelexpert.com/vba-web-browser-in-the-user-form/

Related

"VBA Procedure too large" error while importing HTML Data

I have a code to import HTML data from a website.
It works for importing data up to 94 Excel rows. After that it gives error
VBA Procedure too large.
I repeat the code started from ieApp.Navigate "https://icms.indianrail.gov.in/reports/ReportServlet?reportAction=Utility&reportType=LocoCurrStatus&subAction=main to End If for each row.
How do I modify the code for more than 600 rows?
Sub GetTable()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
'create a new instance of ie
Set ieApp = New InternetExplorer
'you don’t need this, but it’s good for debugging
ieApp.Visible = True
'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "https://icms.indianrail.gov.in/reports/"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc.forms(0)
.UserId.Value = "88888"
.Password.Value = "******"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'now that we’re in, go to the page we want
ieApp.Navigate "https://icms.indianrail.gov.in/reports/ReportServlet?
reportAction=Utility&reportType=LocoCurrStatus&subAction=main"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'get the table based on the table’s id
Set ieDoc = ieApp.Document
With ieDoc.forms(0)
.trainNo.Value = Sheets("sheet1").Range("B2").Value
.startDate.Value = Format(Date - 1, "dd-mmm-yyyy")
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.Item("TABLE_6")
'copy the tables html to the clipboard and paste to teh sheet
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Sheet1.Select
Sheet1.Range("D2").Select
Sheet1.PasteSpecial "Unicode Text"
End If
End Sub
My Excel Sheet:

VBA Get webpage Link and Download File to

Is a long time ago to programming VBA. I want to fetch in a web Table all Linked PDF Files in coll um (x). First I have created the logins and navigate to the site to fetch file.
Site table:
Sub goToShopWH()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim clip As Object
'Table Grapping
Dim ieTable As Object
'create a new instance of ie
'Set ieApp = New InternetExplorer
Set ieApp = CreateObject("InternetExplorer.Application")
'you don’t need this, but it’s good for debugging
ieApp.Visible = True
'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "https://website.com/ishop/Home.html"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents:
Loop
' Login to site
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc '.forms("loginForm_0")
.getElementById("loginField").Value = "username"
.getElementById("password").Value = "Password"
.getElementById("loginSubmit").Click
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'now that we’re in, go to the page we want
'Switsh to search form
ieApp.Navigate "https://website.com/ishop/account/MyAccount,$comp$account$AccountNavigation.orderHistory.sdirect?sp=Saccount%2FOrderHistory"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
' fillout form
Set ieDoc = ieApp.Document
With ieDoc '.forms("Form_0")
.getElementById("PropertySelection_2").Value = "7"
.getElementById("commtxt").Value = "190055" 'Projekt Nummer oder Text.
.getElementById("Submit_0").Click
End With
Do
DoEvents
Loop Until ieApp.ReadyState = 4
Application.Wait Now + TimeSerial(0, 0, 5)
With ieDoc '.forms("Form_1")
.getElementById("PropertySelection").Value = "3"
.getElementById("PropertySelection").FireEvent ("onchange")
End With
Do
DoEvents
Loop Until ieApp.ReadyState = 4
Application.Wait Now + TimeSerial(0, 0, 5)
End With
Set webpage = ieApp.Document
Set table_data = webpage.getElementsByTagName("tr")
End Sub
Please help my to solve this to get I want import Table to sheet2 and download all PDF in ("Table"),("tbody")(tr)(1 to X),(td)(10),(href).click
I think you are after something like this.
Sub webpage()
Dim internet As Object
Dim internetdata As Object
Dim div_result As Object
Dim header_links As Object
Dim link As Object
Dim URL As String
Set internet = CreateObject("InternetExplorer.Application")
internet.Visible = True
URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
internet.Navigate URL
Do Until internet.ReadyState >= 4
DoEvents
Loop
Application.Wait Now + TimeSerial(0, 0, 5)
Set internetdata = internet.Document
Set div_result = internetdata.getelementbyid("res")
Set header_links = div_result.getelementsbytagname("h3")
For Each h In header_links
Set link = h.ChildNodes.Item(0)
Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
Next
MsgBox "done"
End Sub
Or, perhaps this.
' place your URL in cell L1
Sub HREF_Web()
Dim doc As HTMLDocument
Dim output As Object
Set IE = New InternetExplorer
IE.Visible = False
IE.navigate Range("L1")
Do
'DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set doc = IE.document
Set output = doc.getElementsByTagName("a")
i = 5
For Each link In output
'If link.InnerHTML = "" Then
Range("A" & i).Value2 = link
' End If
i = i + 1
Next
MsgBox "Done!"
End Sub

add value in web page text box using vba

I want to add value in web page text box but getting object error.
I can't provide url as it will not work outside the office.
below html code:text box :
<input type="text" size="40" name="agent" id="go" value="">
Search :
<button type="submit">Submit</button>
VBA:
Sub login_page()
Dim ieApp As SHDocVw.InternetExplorer
Dim iedoc As MSHTML.HTMLDocument
IEApp.Visible = True
Set ieApp = New SHDocVw.InternetExplorer
ieApp.Visible = True
ieApp.navigate "http:/Login"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set iedoc = ieApp.document
with iedoc.forms(0)
.user.Value = "id"
.Password.Value = "Pass"
.submit
End With
ieApp.navigate "http:action=view"
Do While ieApp.Busy: DoEvents: Loop
'Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
ieApp.navigate "http:action=run"
Do While ieApp.Busy: DoEvents: Loop
ieApp.navigate "http:Report?"
action=run&category=interfaces&template=base%2Frouterprotocols&section=5"
Do While ieApp.Busy: DoEvents: Loop
ieApp.document.parentWindow.execScript "window.location='Go?action=agent'"
End Sub
There is an id so use it
ieApp.document.getElementById("go")
Preceeding code
Dim ieApp As InternetExplorer
Set ieApp = New InternetExplorer
With ieApp
.Visible = True
.Navigate2 "URL"
While .Busy Or .readyState < 4: DoEvents: Wend
.document.getElementById("go").value = "xyz"
End With
let me help you.
Dim ie As New InternetExplorer
Dim elemnts As Object
Dim elem As Object
ie.Navigate url
Do While ie.ReadyState = 4: DoEvents: Loop 'Do While.
Do Until ie.ReadyState >= 3: DoEvents: Call aceitaAlerta(False): Loop 'Do Until
Set ELEMENTS = ie.Document.all
For Each elem In ELEMENTS
on error goto NextOne
If elem.name = "agente" And elem.id = "go" Then
elem.Value = "NEWVALUE"
elem.innerText = "NEWVALUE"
Exit For
End If
NextOne:
on error goto 0
Next elem

Copy content of the last popup window

I have code to open IE, login with username/password, tick some checkboxes, click button and open a report on a pop up window.
I am trying to copy the content of the pop up window to an Excel sheet. The code that deals with the pop up window doesn't detect the url.
Sub MyRosterApps()
Dim MyHTML_Element As IHTMLElement
Dim HTMLdoc As HTMLDocument
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Dim ieIEWindow As SHDocVw.InternetExplorer
Dim y As Integer
Const MAX_WAIT_SEC As Long = 5
'Ignore Errors
On Error GoTo Err_Clear
MyURL = "Not a public URL"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
'Enter user / password
HTMLdoc.all.txtUsername.Value = "username" ' Eneter your email id here
HTMLdoc.all.txtPassword.Value = "password" 'Enter your password here
HTMLdoc.all.Item("btnLogin").Click
For Each MyHTML_Element In HTMLdoc.getElementsByName("btnLogin")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
Do
'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
HTMLdoc.all.Item("ucSkillsPicker_lstSkills_35").Click
HTMLdoc.all.Item("btnShowReport").Click
' The Pop Up windows opens
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
' Until here is works fine
' Trying to deal with the Pop Up windows
With objIE
.Visible = True
' I am trying to get the active window url which is the pop up
.navigate ieIEWindow.LocationURL
Do While .Busy = True Or .readyState <> 4: DoEvents: Loop
t = Timer
Do
DoEvents
On Error Resume Next
' Go thru DIV classes and find these two oReportCell .a71
Set nodeList = .document.querySelectorAll("#oReportCell .a71")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While nodeList Is Nothing
If Not nodeList Is Nothing Then
'Paste the value found in DIV classes in Sheet1
With ThisWorkbook.Worksheets("Sheet1")
For i = 0 To nodeList.Length - 1
.Cells(1, i + 1) = nodeList.Item(i).innerText
Next
End With
End If
.Quit
End With
Err_Clear:
If Err <> 0 Then
'Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
This code below is separate from above. If I run just like this it does what I need. Of course, I have to paste the targeted window url.
.navigate "url of the pop up window"
The issue is that the pop up window url expires or something like that.
After some time the page says that I have to go through selecting some check boxes and submit.
Option Explicit
Public Sub GrabLastNames()
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Const MAX_WAIT_SEC As Long = 5
Set objIE = New InternetExplorer
With objIE
.Visible = True
' Paste targeted window. In my case is the pop up window
.navigate "url of the pop up window"
Do While .Busy = True Or .readyState <> 4: DoEvents: Loop
t = Timer
Do
DoEvents
On Error Resume Next
Set nodeList = .document.querySelectorAll("#oReportCell .a71")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While nodeList Is Nothing
If Not nodeList Is Nothing Then
With ThisWorkbook.Worksheets("Sheet3")
For i = 0 To nodeList.Length - 1
.Cells(1, i + 1) = nodeList.item(i).innerText
Next
End With
End If
.Quit
End With
End Sub

Navigating through websites

My code is able to interact with the first webpage it brings up, but then as soon as i navigate away from it, my code gives me a '424' object required error. Here is an example.
EX: go to yahoo.com - search for 'Earth' - click on the Yahoo logo to return to the yahoo homepage
Sub InternetPractice()
Dim ie As InternetExplorer
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate "https://www.yahoo.com"
Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
ie.document.getElementById("uh-search-box").Value = "Earth"
ie.document.getElementById("uh-search-button").Click
Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
ie.document.getElementById("logo").Click
End Sub
Using VBA with the internet is new to me and any help is appreciated!
EDIT:
I think you are not giving enough time for ie to load... It is working for me.
So you can try this code that gives more time and try to load 3 times before aborting.
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub InternetPractice2()
Dim IE As InternetExplorer
Dim HTMLDoc As HTMLDocument
Dim logo As Object
Dim n As Long
Set IE = New InternetExplorer 'Set IE = CreateObject("InternetExplorer.Application")
With IE
.Silent = True
.Visible = True
.Navigate "https://www.yahoo.com"
End With
WaitIE IE, 5000
Set HTMLDoc = IE.Document
HTMLDoc.getElementById("uh-search-box").Value = "Earth"
HTMLDoc.getElementById("uh-search-button").Click
load:
WaitIE IE, 10000
Set logo = HTMLDoc.getElementById("logo")
If Not logo Is Nothing Then
logo.Click
ElseIf logo Is Nothing And n < 4 Then
n = n + 1
GoTo load
End If
WaitIE IE, 5000
'Set ie to Nothing
IE.Quit
Set IE = Nothing
End Sub
Sub WaitIE(IE As Object, Optional time As Long = 250)
'Code from: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set
Dim i As Long
Do
Sleep time
Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _
vbCrLf & vbTab & "Busy: " & CStr(IE.Busy)
i = i + 1
Loop Until IE.READYSTATE = 4 Or Not IE.Busy
End Sub
Original Answer
Try closing ie in the end of the code and add some delay, because if you step the code with F8, you will see that it works:
Sub InternetPractice2()
Dim ie As InternetExplorer
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate "https://www.yahoo.com"
Do While ie.Busy = True Or ie.READYSTATE <> 4: DoEvents: Loop
ie.Document.getElementById("uh-search-box").Value = "Earth"
ie.Document.getElementById("uh-search-button").Click
'Add delay After .Click
Do While ie.Busy = True Or ie.READYSTATE <> 4: DoEvents: Loop
Application.wait Now+Timevalue("00:00:05")
ie.Document.getElementById("logo").Click
'Set ie to Nothing
Set ie = Nothing
End Sub
Also close all iexplorer.exe on Windows Task Manager.

Resources