I have a script on VBA that loads up a site, copies data & pastes it on a hidden page. It has worked before but I have to run it about 20 times to get it to do what I want it to do. The errors are very inconsistent and I am debating if I should proceed with this as I need at least a 95% success rate.
Majority of the time the data is not copied correctly & the page is blank, the script finishes with out error but nothing happens.
The other time the script fails is on Set ieTable = ieDoc.all.item -- Do While ieApp.Busy: DoEvents: Loop -- Set ieDoc = ieApp.Document
As you can see, just to be able to check where the errors are occurring I have plagued everything with message prompts.
Sub Pull_Data()
'Kills ALL IE windows
On Error GoTo Ignore:
Call IE_Sledgehammer
Ignore:
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Dim UserName As String, Password As String
Dim SubmitButton
Dim i As Integer
'Create anew instance of ie
Set ieApp = New InternetExplorer
ieApp.Navigate "Intranet site I cannot share"
'Debugging
ieApp.Visible = True
'When busy - wait
On Error GoTo Skip_wait
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Login
'Debugging
Skip_wait:
MsgBox ("You skipped the first wait")
Login:
'*****common error*****
Set ieDoc = ieApp.Document
Set SubmitButton = ieDoc.getElementsByTagName("input")
'Login script
With ieDoc.forms(0)
If Err.Number = 424 Then
GoTo skip_login
.UserName.Value = "USERNAME"
.Password.Value = "PASSWORD"
SubmitButton(i).Click
End If
End With
GoTo wait
'Debugging
skip_login:
MsgBox ("You skipped the login")
'When busy - wait
wait:
On Error GoTo Skip_waiting
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Copypaste
Skip_waiting:
MsgBox ("You skipped the second wait")
'Copy&paste script
Copypaste:
Set clip = New DataObject
Set ieTable = ieDoc.all.item
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Sheets("Raw Data").Range("E2").PasteSpecial "Unicode Text"
'Kills all activeX/controls copied from ieDoc.all.item
Sheets("Raw Data").DrawingObjects.Delete
'Kills ALL IE windows
On Error GoTo Ignored:
Call IE_Sledgehammer
Ignored:
End Sub
I do know about the pull data from web option which was my goto on this stuff, but since our office has changed its security settings, its made that option impossible. Other than this, I cannot think of a way to pull data from a click of a button.
Is this option worth it? For anyone with experience with this, Can you tell me if this option is reliable? I cannot for the life of me work out why this is failing.
HTML:
<html><head>
<title>
Open Questions Summary
</title>
<link rel="stylesheet" href="/styles.css" type="text/css">
</head>
<body bgcolor="#FFFFFF">
<table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
<tbody><tr>
<td colspan="2">
Customer Sector:
<form method="get" action="INTERNAL WORK SITE">
<select name="strCustomerType">
<option value="residential" selected="selected">Residential</option>
<option value="business">Business</option>
</select>
<input name="soobmit" value="Submit" type="submit">
</form></table>
From your code and description, it seems that you want to fill value into the textbox and handle the dropdownlist, I suggest you could refer to the following code, they all work well on my machine:
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
Handle dropdown list:
Public Sub ClickTest()
Dim ie As Object, evtChange As Object
Dim item As Object
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate2 "<the website url>"
While .Busy Or .readyState <> 4: DoEvents: Wend
Set evtChange = .Document.createEvent("HTMLEvents")
evtChange.initEvent "change", True, False
'get the select element. Please note the index, it is starting from 0.
Set item = ie.Document.getElementsByTagName("select")(0)
expCcy = "EUR"
'Set the Expression Currency
For Each o In item 'Sets Expression Currency
If o.Value = expCcy Then
o.Selected = True
o.dispatchEvent evtChange
Exit For
End If
Next
End With
End Sub
More detail information, please check the following threads: Textbox related thread and DropDownList related thread.
Related
This is relating to the submit button of the login screen
HTML:
<TD background=/frontend/images/greenback.gif width=302><INPUT type=submit value="Login now" name=submit> </TD>
I enter the username and password into the box but the script stops at .Submit
Sub GetTable()
'Kills any open IE windows.
On Error GoTo Ignore
Call IE_Sledgehammer
Ignore:
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Dim UserName As String, Password As String
'Create anew instance of ie
Set ieApp = New InternetExplorer
'Debugging
ieApp.Visible = True
'Opening this page prompts login screen
ieApp.Navigate "CANNOT SHARE, INTERNAL WORK SITE"
'When busy - wait
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'Pop up window
On Error GoTo skip_Popup
ieApp.Document.all.item("submitBn").Focus
SendKeys "~"
skip_Popup:
'Login script
On Error GoTo Skip_Login
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc.forms(0)
.UserName.Value = "test1"
.Password.Value = "test2"
.Submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Skip_Login:
'Copy page Info
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.item
'Copy Paste the page
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
'Location of data
Sheets("Raw Data").Range("E2").PasteSpecial "text"
End If
'Delete any form controls that make it into the sheet
Sheets("Raw Data").DrawingObjects.Delete
'Kills ALL IE windows
Call IE_Sledgehammer
Set ieApp = Nothing
End Sub
Also this is not critical, how do I just select the table on the page and not everything else? It doesn't have a name so I am stuck with this one also.
HTML:
<table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
Try using attribute = value css selector
ie.document.querySelector("[name=submit]").click
For your table your best bet is to locate it by it's relationship to other elements/attributes. Impossible to advise further without seeing more html. Failing that if there is a unique attribute or attribute=value in that table (not present in other tables) then combine that to id the table
e.g.
ie.document.querySelector("table[width='400']")
This is a less robust method.
I tested your code and I am able to produce the issue.
As an alternative, you can try to loop through input elements and try to find the submit and click it.
Set objCollection = ieApp.document.getElementsByTagName("input")
i = 0
While i < objCollection.Length
If objCollection(i).Type = "submit" And _
objCollection(i).Name = "submit" Then
objCollection(i).Click
End If
i = i + 1
Wend
I am using office 2019. in VBA i am trying to click on follow button. on INSTAGRAM but it did't click on that. simply page open and then nothing will happen.
so, plz help me because it is spine of my project.
Sub one()
Dim IE As Object
Dim doc As HTMLDocument
Dim ele As IHTMLElement
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = 1
IE.navigate "https://www.instagram.com/gal_gadot/"
Do
Loop Until IE.readyState = 4
Set doc = IE.document
'doc.getElementsByTagName("button").innerText
'doc.getElementsByClassName("_5f5mN jIbKX _6VtSN yZn4P ").innerText
For Each ele In doc.getElementsByTagName("span")
' If InStr(ele.innerText, "Follow") > 0 Then ele.Click
On Error Resume Next
If ele.Value = "Follow" Then
ele.Click
End If
Next
For Each ele In doc.getElementsByTagName("button")
' If InStr(ele.innerText, "Follow") > 0 Then ele.Click
On Error Resume Next
If ele.Value = "Follow" Then
ele.Click
End If
Next
End Sub
HERE IS HTML FILE
<span class="BY3EC bqE32">
<span class="vBF20 _1OSdk">
<button class="_5f5mN jIbKX _6VtSN yZn4P ">Follow</button></span>
<span class="mLCHD _1OSdk">
<button class="_5f5mN jIbKX KUBKM yZn4P m4t9r ">
<div class="OfoBO">
<div class="_5fEvj coreSpriteDropdownArrowWhite">
</div>
</div>
</button>
</span>
</span>
The script will help you click on that follow button but you can't follow her until you log in because when you click on that button, it will lead you to the log in page. Btw, you should always define any timed loop so that you can get out of that do loop in case the element is not available. There are several posts in SO which have got it covered.
Sub FollowGalGadot()
Const Url$ = "https://www.instagram.com/gal_gadot/"
Dim IE As New InternetExplorer, post As Object
With IE
.Visible = True
.navigate Url
While .Busy = True Or .readyState < 4: DoEvents: Wend
Do
DoEvents
On Error Resume Next
Set post = .document.querySelectorAll("a[href*='follow'] > button")
On Error GoTo 0
Loop While post.Length = 0
post.item(0).Click
End With
Stop
IE.Quit
End Sub
Thank you, SIM! I’m not a programmer, but I made a little change and it worked great!
Sub FollowGalGadot()
Const Url$ = "https://www.instagram.com/gal_gadot/"
Dim IE As New InternetExplorer, post As Object
With IE
.Visible = True
.navigate Url
While .Busy = True Or .readyState < 4: DoEvents: Wend
While post Is Nothing
On Error Resume Next
Application.Wait Now + TimeValue("00:00:001")
Set post = .document.querySelector("._5f5mN.jIbKX._6VtSN.yZn4P")
If Not post Is Nothing Then
post.Click
Debug.Print "it's done!!!"
Else:
Debug.Print "trying again"
End If
On Error GoTo 0
Wend
End With
Stop
IE.Quit
End Sub
I'm trying to check all the checkboxes available on a webpage via VBA since the name convention doesnt appear to be one in which I can be selective. However I cannot seem to get anything to work. I can login to the website and navigate to the section of the website I want but cannot cross this hurdle. Any help would be greatly appreciate. Below is the source code from the webpage.
<li data-product-family="30yr"
data-product-amortizationTerm="30"
data-product-type="Conventional"
data-product-amortizationType="Fixed"
>
<label>
<input type="checkbox"
value="154232"
class="product-Conventional product-item"
data-authorized-remittance-types="ActualActual "
/>30-Year Fixed Rate - 110k Max Loan Amount</label>
</li>
VBA I attempted to write (edited)... code I'm using presently:
Public Sub TestIE()
Dim IE As Object
Dim aNodeList As Object, i As Long
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' Send the form data To URL As POST binary request
IE.Navigate "https://"
' Statusbar
Application.StatusBar = "Page is loading. Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
IE.Visible = True
Set aNodeList = IE.document.querySelectorAll("input[type=checkbox]")
If aNodeList Is Nothing Then Exit Sub
For i = 0 To aNodeList.Length
aNodeList.Item(i).Checked = True
Next i
End Sub
You can try to get a nodeList of the checkboxes with:
IE.document.querySelectorAll("input[type=checkbox]")
You can traverse the nodeList along its .Length property.
E.g.
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelectorAll("input[type=checkbox]")
If aNodeList Is Nothing Then Exit Sub
For i = 0 To aNodeList.Length -1
On Error Resume Next
aNodeList.item(i).Checked = True
On Error GoTo 0
Next i
I am trying to auto populate fields on a webpage using excel VBA. I am stuck on the drop down lists which are in an iframe.
Here is the website code that I am working with:
First the iframe code:
<iframe id="main_content_window"
style="width:100%;height:99.5%;border:none;" onload="resizeEmbeddedPanel();"
scrolling="yes" src="/system/workspace.php?
filter=overview&is_runtime=true&is_internal_admin=false"></iframe>
And here is the drop down menu that I'm trying to auto fill:
<select storage_var="1" object_id="270FBBA69CC911E786D7F8BC12333350"
label_text="Choose+Program%3A"
linked_var="DM:Submission.none.policy.line_of_business"
context="270FBBA69CC911E786D7F8BC12333350" data_type="Text"
id="270FBBA69CC911E786D7F8BC12333350_droplist_127072016125151333_FIELD"
style="background-color:#FFFFFF;color:#000000;cursor:default;;width:100%;"
onselectstart="return true" field_data_type="Text"
onkeydown="top.onFieldKeyDown(event, window, 0);"
onkeyup="top.onFieldKeyUp(event, window, 0);"
onpaste="top.onFieldKeyUp(event, window, 0);" onblur="return
top.defaultBlurEvent(this, -1);" onchange="
return
window.ev_270FBBA69CC911E786D7F8BC12333350_droplist
_127072016125151333_action(event); " date_format="mm/dd/yy" value=""
class="">
<option value="">Please Select</option>
<option value="HO_FLD">Home & Flood</option>
<option value="FLD">Flood Only</option></select>
Everything is working until I get to the drop down menus on the webpage. This is what I have so far, I included what isn't working in my code (near the bottom):
Sub Superior()
Dim ieApp As Object
Dim div As Variant
'create a new instance of ie
Set ieApp = CreateObject("InternetExplorer.Application")
ieApp.Visible = True
ieApp.navigate "website"
Wait 1
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
ieApp.document.all("login_email").Value = "username"
ieApp.document.all("login_password").Value = "password"
ieApp.document.all("login_button").Click
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Wait 3
Dim button As HTMLInputButtonElement
Set button =
ieApp.document.getElementById("internal_tab_text_client_products")
button.Focus
button.Click
Dim HTMLdoc As MSHTML.HTMLDocument
Dim htmlWindow As MSHTML.HTMLWindow2
Set HTMLdoc = ieApp.document
Set htmlWindow = HTMLdoc.frames(0)
htmlWindow.execScript ("toggleNewBusinessMenu();")
htmlWindow.execScript ("launchNewBusiness('12','',null);")
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
htmlWindow.document.all("_text_5204102016102444865_FIELD").Value =
ThisWorkbook.Sheets("SUPERIOR").Range("a1")
htmlWindow.document.all("_text_5404102016102444866_FIELD").Value =
ThisWorkbook.Sheets("SUPERIOR").Range("a2")
'Object variable or with block not set (1st option I tried)
HTMLdoc.getElementById("270FBBA69CC911E786D7F8BC12333350
_droplist_127072016125151333_FIELD").setAttribute "Value", "FLD"
'Object variable or with block not set (2nd option I tried)
HTMLdoc.getElementById("95BC5CFD99BA11E786D7F8BC12333350_droplist
_127072016125151333_FIELD").selectedIndex , 1
End Sub
Sub Wait(Seconds)
CreateObject("WScript.Shell").Run "%COMSPEC% /c ping 127.0.0.1 -n " _
& Seconds + 1, 0, True
End Sub
EDIT:
Appears that my code isn't recognizing the drop down. I've also tried using the following code:
Set HTMLdoc = ieApp.document
Set frame = HTMLdoc.getElementsByName("main_content_window")(0)
Set HTMLdoc = frame.contentDocument
HTMLdoc.querySelector("select[id='F6F136889A5511E786D7F8BC12333350_droplist
_127072016125151333_FIELD']").selectedIndex = 2
This also runs an error which says "Object variable or with block not set". Does anyone know why this would be happening?
Thanks!
I am trying to open a link on a webpage after logging in with VBA in excel. So far my code successfully opens the website and logs on. However, no examples I've seen in the forums seem to work for actually opening the next link.
HTML Code from the site:
<td class="nrmlFnt nWrap">
<a id="ctl00_wpm_ac_ac_rbk_ctl01_lnkBrokerageAccountName" oncontextmenu="return false;" href="javascript:__doPostBack('ctl00$wpm$ac$ac$rbk$ctl01$lnkBrokerageAccountName','')">Retirement</a>
</td>
While the innertext and ID are unique, I've been unable to select them.
I am new to VBA and may not have been implementing some of the solutions to similar problems quite right. Below is my code:
Dim HTMLdoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Private Sub btnUpdate_click()
'Create Variables for web browsing
Dim MyHTML_Element As IHTMLElement 'Elements to search for: textboxes, buttons etc...
Dim MyURL As String
'Dim IE As InternetExplorerMedium
'Clear errors to prevent from stopping code
On Error GoTo Err_Clear
'Input Desired webpage login URL
MyURL = "https://client.schwab.com/Login/SignOn/CustomerCenterLogin.aspx"
Set MyBrowser = New InternetExplorer 'Creates new browser session
MyBrowser.Silent = True 'Avoids Pop-ups
MyBrowser.navigate MyURL 'Navigates to URL
MyBrowser.Visible = True 'Opens browser window. Change to False to run w/o opening
'Wait for web page to fully load
Do
DoEvents
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
'Enter Username:
HTMLdoc.all.ctl00_WebPartManager1_CenterLogin_LoginUserControlId_txtLoginID.Value = "username"
'Enter Password:
HTMLdoc.all.txtpassword.Value = "password"
'Click Login button on webpage:
For Each MyHTML_Element In HTMLdoc.getElementsByTagName("a")
If MyHTML_Element.ID = "ctl00_WebPartManager1_CenterLogin_LoginUserControlId_btnLogin" Then MyHTML_Element.Click: Exit For
Next
'Wait for web page to fully load
Do
DoEvents
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
'Select Account to be displayed:
Set HTMLdoc = MyBrowser.document
Set e = HTMLdoc.getElementById("ctl00_wpm_ac_ac_rbk_ctl01_lnkBrokerageAccountName")
e.Click
'Wait for web page to fully load
Do
DoEvents
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
'Define Err_Clear Function:
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
I feel this should be something pretty simple like the following, but it hasn't worked:
Set MyHTML_Element= MyBrowser.Document.getElementByID("ctl00_wpm_ac_ac_rbk_ctl01_lnkBrokerageAccountName").getElementsByTagName("a")(0)
MyHTML_Element.Click
I have also tried the following with no success:
For Each MyHTML_Element In HTMLdoc.getElementsByTagName("a")
If MyHTML_Element.ID = "ctl00_wpm_ac_ac_rbk_ctl01_lnkBrokerageAccountName" Then MyHTML_Element.Click: Exit For
Next
The webpage loads, logs in and then... nothing happens.
So I got it to work finally. I apparently needed the webpage to finish loading and the simple "READYSTATE_COMPLETE" didn't cut it. So I ended up with this to make sure the page fully loaded:
With MyBrowser
Do While .Busy Or .readyState <> 4
DoEvents
Loop
End With
And then I used the following code to select the link:
Set HTMLdoc = MyBrowser.document
Set e = HTMLdoc.getElementById("ctl00_wpm_ac_ac_rbk_ctl01_lnkBrokerageAccountName")
e.Click
It finally goes to the correct page! Now I just need to pull the correct data... easy right?