I have the code below to login into the website in the code. However, the login button is not being clicked. I am new to Excel VBA, what do you suggest, please?
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub Myenter()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
On Error GoTo Err_Clear
MyURL = "https://willemendrees.nl/fn/login/"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
HTMLDoc.all.id_username.Value = "amsterdam#willemendrees.nl"
HTMLDoc.all.id_password.Value = "*****"
For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
End With
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
You can use a CSS attribute = value selector of [tabindex='3']. This targets the login button by its tabindex attribute whose value is 3.
HTMLDoc.querySelector("[tabindex='3']").Click
Whole thing:
Option Explicit
Public Sub AttemptLogin()
Dim IE As New InternetExplorer
With IE
.Visible = True
.Navigate2 "https://willemendrees.nl/fn/login/"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
With .querySelector("#id_username")
.Focus
.Value = "amsterdam#willemendrees.nl"
End With
With .querySelector("#id_password")
.Focus
.Value = "***"
End With
.querySelector("[tabindex='3']").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
Stop '<== Delete me later
.Quit
End With
End Sub
It seems there are two form elements on that html page and the login is the second. Identify, then submit the form.
HTMLDoc.all.id_username.Value = "amsterdam#willemendrees.nl"
HTMLDoc.all.id_password.Value = "*****"
HTMLDoc.getelementsbytagname("form")(1).submit
The index number of a collection of elements is zero-based.
Related
My VBA code is not able to select the second drop down option once the first drop down is selected. Not sure why one dropdown is loading and second is not responding as per below code? Appreciate if you could help on fixing this. Regards
Dim IE As InternetExplorer
Dim HTMLDoc As HTMLDocument
Dim commodityStr As String
Dim commodityObj As HTMLObjectElement
Dim commodityCodes As IHTMLElementCollection
Dim codeCounter As Long
Dim EDateStr As String
Dim EDateObj As HTMLObjectElement
Dim EdateCodes As IHTMLElementCollection
Dim i As Integer
commodityStr = "MADHYA PRADESH"
EDateStr = "REWA"
Set IE = New InternetExplorer
With IE
.Visible = True
.navigate "http://hydro.imd.gov.in/hydrometweb/(S(ryta1dvaec5pg03bdnxa5545))/DistrictRaifall.aspx"
While .Busy Or .readyState <> READYSTATE_COMPLETE: Wend
Set HTMLDoc = IE.document
End With
Set commodityObj = HTMLDoc.getElementById("listItems")
For codeCounter = 0 To commodityObj.Length - 1
If commodityObj(codeCounter).innerText = commodityStr Then
commodityObj.Value = commodityObj(codeCounter).Value
commodityObj.Focus
commodityObj.FireEvent ("onchange")
While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE: Wend
Exit For
End If
Next
Set EDateObj = HTMLDoc.getElementById("DistrictDropDownList")
For codeCounter = 0 To EDateObj.Length - 1
If EDateObj(codeCounter).innerText = EDateStr Then
EDateObj.Value = EDateObj(codeCounter).Value
While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE: Wend
commodityObj.Focus
commodityObj.FireEvent ("onchange")
Exit For
End If
Next
You need a timed loop to allow for that execution of the onchange event. Also, you can make use of css attribute = value selectors to remove loops when targeting elements. It is likely the page does an XHR request so inspect via dev tools to see if that is the case.
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub MakeSelections()
Dim ie As InternetExplorer, ele As Object, t As Date
Const MAX_WAIT_SEC As Long = 5
Dim commodity As String, iDate As String
commodity = "MADHYA PRADESH"
iDate = "REWA"
Set ie = New InternetExplorer
With ie
.Visible = True
.Navigate2 "http://hydro.imd.gov.in/hydrometweb/(S(3qitcijd521egpzhwqq3jk55))/DistrictRaifall.aspx"
While .Busy Or .readyState < 4: DoEvents: Wend
.document.querySelector("[value='" & commodity & "']").Selected = True
.document.querySelector("[name=listItems]").FireEvent "onchange"
t = Timer
Do
On Error Resume Next
Set ele = .document.querySelector("[value='" & iDate & "']")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If Not ele Is Nothing Then
ele.Selected = True
.document.querySelector("#GoBtn").Click
Else
Exit Sub
End If
Stop
.Quit
End With
End Sub
I need to enter to this button but I can't find the name, Id or anything which help me to identify the bottom.
This is the code in HTML.
Create Third Party Customer
What code can I use in VAB to connect with this button?
This is the code:
VBA:
Sub test()
Dim IE As New InternetExplorer, html As HTMLDocument
With IE
.Visible = True
.navigate "http://zvc-t-mdmap01:7507/utils/enterLogin.jsp"
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set html = .document
End With
html.getElementById("username").Value = Sheets("InfoSphere").Range("i4")
html.getElementById("password").Value = Sheets("InfoSphere").Range("i5")
html.getElementById("company_code").Value = Sheets("InfoSphere").Range("i6")
html.getElementById("loginButton_label").Click
Application.Wait (Now + TimeValue("0:00:05"))
With IE
.Visible = True
.navigate "http://zvc-t-mdmap01:7507/worklist/worklistconsole.jsp?colAreaName=Third%20Party%20Customer%20Management%20Process"
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set html = .document
End With
Set link = IE.document.getElementsByTagName("a")
For Each l In link
If l.innerText = "Create Third Party Customer" Then
l.Click
Exit For
End If
Next l
'Add
IE.document.querySelector("[stepname='Create Third Party Customer']").Click
End Sub
It didn't work but I don't receive an error either, this is the final code:
Sub test()
Dim IE As New InternetExplorer, html As HTMLDocument
Dim aTags As Object, aTag As Object
With IE
.Visible = True
.navigate "http://zvc-t-mdmap01:7507/utils/enterLogin.jsp"
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set html = .document
html.getElementById("username").Value = Sheets("InfoSphere").Range("i4")
html.getElementById("password").Value = Sheets("InfoSphere").Range("i5")
html.getElementById("company_code").Value = Sheets("InfoSphere").Range("i6")
html.getElementById("loginButton_label").Click
Application.Wait (Now + TimeValue("0:00:05"))
.Visible = True
.navigate "http://zvc-t-mdmap01:7507/worklist/worklistconsole.jsp?colAreaName=Third%20Party%20Customer%20Management%20Process"
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set html = .document
End With
'Add
Set aTags = html.getElementsByTagName("a")
For Each aTag In aTags
If InStr(aTag.outerHTML, "Create Third Party Customer") > 0 Then
aTag.Click
Exit For
End If
Next
End Sub
Try an attribute = value selector
ie.document.querySelector("[stepname='Create Third Party Customer']").click
Brute force approach:
Dim aTags As Object, aTag As Object
Set aTags = html.getElementsByTagName("a")
Dim event_onClick As Object
Set event_onClick = html.createEvent("HTMLEvents")
event_onClick.initEvent "click", True, False
For Each aTag In aTags
If InStr(aTag.outerHTML, "Create Third Party Customer") > 0 Then
With aTag
.Click
.dispatchEvent event_onClick
.FireEvent "onclick"
End With
Exit For
End If
Next
I'm trying to extract the start date from the following, but my code cant seem to see the 'nested" div "daysTips" any help would be great. Thank you.
HTML Screen Shot:
Sub warranty2()
Dim elements As IHTMLElementCollection
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
IE.Visible = True
IE.navigate "https://pcsupport.lenovo.com/gb/en/products/laptops-and-netbooks/thinkpad-x-series-laptops/thinkpad-x280-type-20kf-20ke/20ke/20kes5sd09/pc0x5yhz/warranty"
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set Doc = IE.document
Set elements = Doc.getElementsByClassName("daysTips")
For i = 0 To elements.Length - 1
Sheet1.Range("G" & (i + 1)) = elements(i).innerText
Next i
IE.Quit
End Sub
You need to do the click first on the down chevron
HTML:
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
With IE
.Visible = True
.navigate "https://pcsupport.lenovo.com/gb/en/products/laptops-and-netbooks/thinkpad-x-series-laptops/thinkpad-x280-type-20kf-20ke/20ke/20kes5sd09/pc0x5yhz/warranty"
While .Busy Or .readyState < 4: DoEvents: Wend
IE.document.querySelector(".icon.icon-s-down").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Debug.Print IE.document.querySelector(".daysTips span").innerText
.Quit
End With
End Sub
I am trying to login Web page and fetch data however my login details are not getting update, i have tried all possibilities code from your forum, nothing is working for me
Below is my code, am getting attached error
Sub test()
Dim ie As Object
Dim objCollection As Object
Dim i As Integer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "https://portal.expeditors.com/expo/login"
Do While ie.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
'Get all the elements with input tag name
Set objCollection = ie.document.getElementsByTagName("input")
i = 0
'Loop through all elements and find login form and fill it
While i < objCollection.Length
'Login name
If objCollection(i).Name = "username" Then
objCollection(i).Value = "bom-sumand"
End If
'Store login button in object
If objCollection(i).Type = "submit" Then
Set objElement = objCollection(i)
End If
i = i + 1
Wend
'Click login
objElement.Click
'Clean up
Set ie = Nothing
End Sub
I would use the available ids rather than looping to find the input boxes and sign in. These are much faster selector methods. You can add a .Focus. Also, swop InternetExplorer for InternetExplorerMeduim in some cases.
If problem continues check your internet settings in case site is blocked.
Open the URL via creating an IE instance direct.
Option Explicit
Public Sub Login()
Dim ie As New InternetExplorer 'InternetExplorerMedium
Const MAX_WAIT_SEC As Long = 5
Dim t As Date, ele As Object
With ie
.Visible = True
.navigate "https://portal.expeditors.com/expo/login"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
Do
DoEvents
On Error Resume Next
Set ele = .getElementById("j_username")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If ele Is Nothing Then Exit Sub
With ele
.Focus
.Value = "bob"
End With
With .getElementById("j_password")
.Focus
.Value = "penny"
End With
.getElementById("signInBtn").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
Stop '<== Delete me later
.Quit
End With
End Sub
Macro trying and failing to open a second instance of IE try this.
Sub test()
Dim ie As Object
Dim redURL As String
Dim objCollection As Object
Dim i As Integer
redURL = "https://portal.expeditors.com/expo/login"
On Error Resume Next
Set ie = GetObject(, "InternetExplorer.Application")
If Err Then
Set ie = CreateObject("InternetExplorer.Application")
End If
On Error GoTo 0
ie.Visible = True
ie.Navigate redURL
Do While ie.Busy
Loop
End Sub
I continue to get the above error when running this code. I have tried dozens of web searches and adjustments to fix but unsuccessful. The code is below and any help if very much appreciated.
Public Sub Tagg()
Dim URL As String
Dim ie As SHDocVw.InternetExplorer 'MICROSOFT Internet Controls (shdocvw.dll)
Dim HTMLdoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
Dim loginFrame As HTMLIFrame
Dim usernameInput As HTMLInputElement, passwordInput As HTMLInputElement
Dim username As String, password As String
username = "MTorres" 'CHANGE THIS
password = "melissa1" 'CHANGE THIS
URL = "https://webaccess.tagglogistics.com/cadence/webaccess.net?action=203&Full=Y&args=415878"
Set ie = New SHDocVw.InternetExplorer
With ie
.Visible = True
.navigate URL
Do While .readyState <> READYSTATE_COMPLETE Or .Busy
DoEvents
Loop
Set loginFrame = .document.getElementById("loginframe") ' ****ERROR HERE****
Set HTMLdoc = loginFrame.contentWindow.document
'<input name="username" id="uname" class="ti" maxlength="32" onchange="setUserValue();"
'onkeydown="setupUserValue(event);" onmouseup="return false;" onclick="SelectAll();" onfocus="SelectAll();"
'aria-describedby="cof_username errormsg" type="text">
Set usernameInput = HTMLdoc.getElementsByName("username")(0)
usernameInput.Focus
DoEvents
usernameInput.Value = username
usernameInput.FireEvent "onkeydown"
usernameInput.FireEvent "onchange"
usernameInput.FireEvent "onmouseup"
'<input id="cofisso_ti_passw" name="password" class="ti" maxlength="32" aria-describedby="pass" type="password">
Set passwordInput = HTMLdoc.getElementsByName("password")(0)
passwordInput.Focus
passwordInput.Value = password
'HTMLdoc.forms(0).submit
'<input src="/resources/images/btn_login.gif" alt="Login" title="Login" name="cofisso_btn_login" id="cofisso_btn_login" type="image">
HTMLdoc.getElementById("cofisso_btn_login").Click
Do While .readyState <> READYSTATE_COMPLETE Or .Busy
DoEvents
Loop
'----------- NEW CODE --------------
'Might need this wait loop
While .document.readyState <> "complete"
DoEvents
Wend
'Either reload HTMLdoc from current IE.document:
Set HTMLdoc = .document
'Or if LNKLOGOUT is inside an iframe:
' Dim iframe As HTMLIFrame
' Set iframe = .document.getElementsByTagName("IFRAME")(0) '0 = 1st iframe
' Set HTMLdoc = iframe.contentWindow.document
'HTMLdoc should now be available here - display webpage TEXT TO verify
MsgBox HTMLdoc.body.innerText
'---------- END OF NEW CODE ----------
'Click "Sign Out" link
'<a id="LNKLOGOUT" class="logout" href="https://servicing.capitalone.com/C1/SelfService/CMLogoutIntercept.aspx">Sign Out</a>
HTMLdoc.getElementById("LNKLOGOUT").Click
Do While .readyState <> READYSTATE_COMPLETE Or .Busy
DoEvents
Loop
End With
End Sub
CSS selectors:
You could have shortened most of that by using CSS selectors to target the elements of interest.
The selectors are:
input[name='LoginID']
input[name='Password']
input[type='image']
These says select elements with input tag having attribute name or type, with value of 'Login' or 'Password' or 'image' respectively. "[]" is the selector for attribute.
VBA:
You apply CSS selectors with .querySelector method of document:
.document.querySelector("input[name='LoginID']").Value = USERNAME
.document.querySelector("input[name='Password']").Value = PASSWORD
.document.querySelector("input[type='image']").Click
Code:
Option Explicit
Public Sub Tagg()
Dim URL As String, ie As SHDocVw.InternetExplorer, HTMLdoc As MSHTML.HTMLDocument
Const USERNAME As String = "MTorres"
Const PASSWORD As String = "melissa1"
URL = "https://webaccess.tagglogistics.com/cadence/webaccess.net?action=203&Full=Y&args=415878"
Set ie = New SHDocVw.InternetExplorer
With ie
.Visible = True
.navigate URL
Do While .readyState <> READYSTATE_COMPLETE Or .Busy
DoEvents
Loop
.document.querySelector("input[name='LoginID']").Value = USERNAME
.document.querySelector("input[name='Password']").Value = PASSWORD
.document.querySelector("input[type='image']").Click
Do While .readyState <> READYSTATE_COMPLETE Or .Busy
DoEvents
Loop
Set HTMLdoc = .document
'Other code
.Quit
End With
End Sub
You aren't setting the document and loginframe correctly.
Replace these lines:
Set loginFrame = .document.getElementById("loginframe") ' ****ERROR HERE****
Set HTMLdoc = loginFrame.contentWindow.document
With these:
Set HTMLdoc = ie.Document
Set loginFrame = HTMLdoc.getElementById("loginframe") ' ****ERROR FIXED****
You'll get another error a few lines down when you try to find an element with the name "username" because there is no such element on that page, but hopefully this will get you on the right track.