I am able to pass the excel values to the website and click it through vba. But it opens up another page with title "Results - Research Randomizer" and I dont know how I retrieve those values inside "Set#1". Can anyone give me some idea to retrieve those values into a variable. My code is
Sub OpenPage()
Const myPageTitle As String = "Research Randomizer Form v4.0"
Const myPageURL As String = "http://www.randomizer.org/form.htm"
Dim NoofSet, NoPSet, RangeBeg, RangeEnd As String
NoofSet = Range("b3").Value
NoPSet = Range("c3").Value
RangeBeg = Range("d3").Value
RangeEnd = Range("e3").Value
Dim myIE As SHDocVw.InternetExplorer
Dim doc As HTMLDocument
Dim PageForm As HTMLFormElement
Dim UserIdBox As HTMLInputElement
Dim PasswordBox As HTMLInputElement
Dim HrangeBeg, HrangeEnd As HTMLInputElement
Dim FormButton As HTMLInputButtonElement
Dim Elem As IHTMLElement
'check if page is already open
Set myIE = GetOpenIEByTitle(myPageTitle, False)
If myIE Is Nothing Then
'page isn't open yet
'create new IE instance
Set myIE = GetNewIE
'make IE window visible
myIE.Visible = True
'load page
If LoadWebPage(myIE, myPageURL) = False Then
'page wasn't loaded
MsgBox "Couldn't open page"
Exit Sub
End If
End If
Do
DoEvents
Loop Until myIE.readyState = READYSTATE_COMPLETE
Set doc = myIE.document
Set PageForm = doc.forms(0)
'Get the User Id textbox
'< input class="TextBox" maxlength="15" name="UserName" size="12">
Set UserIdBox = PageForm.elements("numofsets")
'Set the User Id
UserIdBox.Value = NoofSet
'Get the password textbox
'< input class="TextBox" type="password" maxlength="10" name="Password" size="12">
Set PasswordBox = PageForm.elements("numperset")
'Set the password
PasswordBox.Value = NoPSet
Set HrangeBeg = PageForm.elements("rangebeg")
HrangeBeg.Value = RangeBeg
Set HrangeEnd = PageForm.elements("rangeend")
HrangeEnd.Value = RangeEnd
'Submit the form (like clicking the 'Submit' button) to navigate to next page
PageForm.Button.Click
'Wait for the new page to load
Do
DoEvents
Loop Until myIE.readyState = READYSTATE_COMPLETE
myIE.Visible = True
'Working fine till here
'Need to pull the data from the 2nd webisite
End Sub
'returns new instance of Internet Explorer
Function GetNewIE() As SHDocVw.InternetExplorer
'create new IE instance
Set GetNewIE = New SHDocVw.InternetExplorer
'start with a blank page
GetNewIE.Navigate2 "about:Blank"
End Function
'loads a web page and returns True or False depending on
'whether the page could be loaded or not
Function LoadWebPage(i_IE As SHDocVw.InternetExplorer, _
i_URL As String) As Boolean
With i_IE
'open page
.navigate i_URL
'wait until IE finished loading the page
Do While .readyState <> READYSTATE_COMPLETE
Application.Wait Now + TimeValue("0:00:01")
Loop
'check if page could be loaded
If .document.URL = i_URL Then
LoadWebPage = True
End If
End With
End Function
'finds an open IE site by checking the URL
Function GetOpenIEByURL(ByVal i_URL As String) As SHDocVw.InternetExplorer
Dim objShellWindows As New SHDocVw.ShellWindows
'ignore errors when accessing the document property
On Error Resume Next
'loop over all Shell-Windows
For Each GetOpenIEByURL In objShellWindows
'if the document is of type HTMLDocument, it is an IE window
If TypeName(GetOpenIEByURL.document) = "HTMLDocument" Then
'check the URL
If GetOpenIEByURL.document.URL = i_URL Then
'leave, we found the right window
Exit Function
End If
End If
Next
End Function
'finds an open IE site by checking the title
Function GetOpenIEByTitle(i_Title As String, _
Optional ByVal i_ExactMatch As Boolean = True) As SHDocVw.InternetExplorer
Dim objShellWindows As New SHDocVw.ShellWindows
If i_ExactMatch = False Then i_Title = "*" & i_Title & "*"
'ignore errors when accessing the document property
On Error Resume Next
'loop over all Shell-Windows
For Each GetOpenIEByTitle In objShellWindows
'if the document is of type HTMLDocument, it is an IE window
If TypeName(GetOpenIEByTitle.document) = "HTMLDocument" Then
'check the title
If GetOpenIEByTitle.document.Title Like i_Title Then
'leave, we found the right window
Exit Function
End If
End If
Next
End Function
This code will find and identify the open "Results" window and then assign the source code behind it to a variable (my_var). You can then extract what you want from the variable.
' Find the open instance of IE that contains the "Results"
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next
my_url = objShell.Windows(x).document.Location
my_title = objShell.Windows(x).document.Title
If my_title Like "Results - Research Randomizer" Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next
my_var = ie.document.body.innerhtml
Related
I have the following VBA code:
Sub OpenWebPage()
Dim oIE As Object
Dim sURL As String
Dim HTML As HTMLDocument, hDataManager As IHTMLElementCollection, hDropSelect
Dim HWNDSrc As Long
Dim itm As Variant
'objects
Set oIE = CreateObject("InternetExplorer.Application")
'//---Open the browser and log in, then navigate to the data manager
oIE.silent = True 'No pop-ups
oIE.Visible = True
sURL = "https://publicisuk.lumina.mediaocean.com/Admin/DataManager.aspx"
oIE.navigate sURL
'wait for process to complete before executing the next task
Do While oIE.Busy: DoEvents: Loop
Do Until oIE.ReadyState = 4: DoEvents: Loop
'get window ID for IE so we can set it as active window
HWNDSrc = oIE.HWND
'set IE as active window
SetForegroundWindow HWNDSrc
'loop through elements/ items to find username field
For Each itm In oIE.document.All
If itm = "[object HTMLInputElement]" Then
If itm.Name = "username" Then
Debug.Print "Username field found!"
itm.Value = "johnsmith#gmail.com"
Debug.Print "Username: " & itm.Value
Exit For
End If
End If
Next itm
'now loop through to find password element
For Each itm In oIE.document.All
If itm = "[object HTMLInputElement]" Then
If itm.Name = "password" Then
Debug.Print "Password field found!"
itm.Value = "IAmAMonkey"
Debug.Print "Password: " & itm.Value
Application.SendKeys "~", True
Exit For
End If
End If
Next itm
What it does is loads Internet Explorer to an object, and then navigates to a URL where I want to log in. I loop through the elements on the web-page checking for InputElements. When the Username input box is found it sets the .Value to the username, and when the Password input box is found it sets the .Value to the password, after which I send the Enter key, presumably to log in.
Now, the interesting problem. When I run this it prints out that it finds the respective fields, and also prints out their newly set values, however, no text appears in the boxes at all.
I have also tried the following syntax:
oIE.Document.getElementById("username").Value = "johnsmith#gmail.com"
oIE.Document.getElementsByName("username").Value = "johnsmith#gmail.com"
With the same result - there is no error, but the values aren't showing up in the boxes.
Does anyone know why this would be the case or what is wrong with my approach?
Below is the HTML code.
<div id="login-panel">
<input name="username" class="form-required-field" id="username" accesskey="u" type="text" placeholder="Username" value="" data-bind="value: form().username, placeholder: bundle['user.label.html']" htmlescape="true" autocomplete="off" cssclass="form-required-field"><!-- organization select goes here if multiple organizations use the same domain --><div class="inline-organization-panel" id="inline-organization-panel" style="display: none;" data-bind="moSlideVisible: isOrganisationSelectPanelVisible()">
<span id="inline-organization-label" data-bind="text: bundle['organization.panel.label']">Choose organization.</span>
<div data-bind="foreach: organisationInfoArray"></div>
</div>
<input name="password" class="form-required-field" id="password" accesskey="p" type="password" placeholder="Password" value="" data-bind="value: form().password, placeholder: bundle['password.label.html']" htmlescape="true" autocomplete="off" cssclass="form-required-field" csserrorclass="error"><!-- Continent selection goes here if mf-style username and don't have continent cookie -->
I would focus on each element before assigning value then you simply need to remove the disabled attribute from the submit button
Option Explicit
Public Sub LogIn()
Dim ie As SHDocVw.InternetExplorer
Set ie = New SHDocVw.InternetExplorer
With ie
.Visible = True
.Navigate2 "https://publicisuk.lumina.mediaocean.com/mo-cas/login"
While .Busy Or .readyState <> 4: DoEvents: Wend
With .document
With .querySelector("#username")
.Focus
.Value = "johnsmith#gmail.com"
End With
With .querySelector("#password")
.Focus
.Value = "IAMaMonkey"
End With
With .querySelector("#buttonSignin")
.removeAttribute "disabled"
.Click
End With
End With
Stop
End With
End Sub
Here is where I got to, i'll try again a little later, but may help in the meantime.
Dim ie As InternetExplorer
Dim d As HTMLDocument
Dim f As HTMLFormElement
Set ie = New InternetExplorer
ie.Visible = 1
ie.navigate "https://publicisuk.lumina.mediaocean.com/Admin/DataManager.aspx"
Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set d = ie.document
Set f = d.forms(0)
'Putting a break point here and waiting a moment allows access
f.elements("username").Value = "username"
I tested and found that the code would run when setting breakpoints before setting value but wouldn't run without breakpoints.
I think it could be that debug mode adds more delay so I tried to add a separate delay in the code and it works. You could check my sample below:
Sub LOADIE()
Set ieA = CreateObject("InternetExplorer.Application")
ieA.Visible = True
ieA.navigate "https://publicisuk.lumina.mediaocean.com/mo-cas/login"
Do Until ieA.readyState = 4
DoEvents
Loop
delay 4
Set doc = ieA.Document
Set UserName = doc.getElementById("username")
UserName.Value = "johnsmith#gmail.com"
Set Password = doc.getElementById("password")
Password.Value = "IAmAMonkey"
Set btn = doc.getElementById("buttonSignin")
btn.Disabled = False
btn.Click
End Sub
Private Sub delay(seconds As Long)
Dim endTime As Date
endTime = DateAdd("s", seconds, Now())
Do While Now() < endTime
DoEvents
Loop
End Sub
Guys I´m facing trouble to click on an anchor ina web site using a VBA code.
The link I want to click is the following:
BAIXAR ARQUIVOS - DOWNLOAD
I have tried a few methods but they only work for other links on the web site, but not this one.
This is how my code looks right now:
Sub login()
Const Url$ = "https://www.hapvida.com.br/pls/webhap/webNewTrocaArquivo.login"
Dim UserName As String, Password As String, LoginData As Worksheet
Set LoginData = ThisWorkbook.Worksheets("1")
UserName = LoginData.Cells(2, "B").Value
Password = LoginData.Cells(3, "B").Value
Dim ie As InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate Url
ieBusy ie
.Visible = True
Dim oLogin As Object, oPassword As Object, oCodigo As Object
Set oLogin = .Document.getElementsByName("pCpf")(0)
Set oPassword = .Document.getElementsByName("pSenha")(0)
oLogin.Value = UserName
oPassword.Value = Password
.Document.forms(0).submit
End With
For Each l In ie.Document.getElementsByClassName("ultimas_noticias")
If l.tagName = "a" Then
l.Click
End If
Exit For
Next
End Sub
Sub ieBusy(ie As Object)
Do While ie.Busy Or ie.ReadyState < 4
DoEvents
Loop
End Sub
Thanks a lot in advance
Need help how to create excel vba code for this
I'll be needing the codes so I can complete my macro.
Thanks in advance
First, you will need to create a reference to:
Microsoft Internet Controls
Microsoft HTML Object Library
In VBE, click Tools > References
Sub clickLink()
Dim ie As New InternetExplorer, Url$, doc As HTMLDocument
Url = "http://UrlToYourLink.com"
With ie
.navigate Url
Do While .Busy Or .readyState < READYSTATE_COMPLETE
DoEvents
Loop
doc = .document
.Visible = True
End With
Dim myBtn As Object
Set myBtn = doc.getElementsByClassName("button rounded")(0)
myBtn.Click
End Sub
The Internet control is used to browse the webpage and the HTML Objects are used to identify the username and password textboxes and submit the text using the control button.
Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.Document
HTMLDoc.all.Email.Value = "sample#vbadud.com"
HTMLDoc.all.passwd.Value = "*****"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
The program requires references to the following:
1 Microsoft Internet Controls
2. Microsoft HTML Object Library
Microsoft internet controls are a great way to do this, but if you aren't allowed to add new references, here is another way to go about web scraping.
This methode ain't as 'clean' as Microsoft internet controls and HTML object but it gets the job done.
Sub GoogleSearch()
Dim ie As Object
Dim objSearchBnt As Object
Dim objCollection As Object
Dim i As Integer
'initialize counter
i = 0
'Create InternetExplorer Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'navigate to the url
ie.navigate "Www.google.com"
'Statusbar shows in the buttom corner of excel
Application.StatusBar = "Loading, please wait..."
'Wait until page is ready
Do While ie.busy
Application.Wait DateAdd("s", 1, Now)
Loop
'Store all the elements with input tag
Set objCollection = ie.Document.getElementsByTagName("input")
'Go through all input elements
While i < objCollection.Length
'input search field
If objCollection(i).Name = "q" Then
objCollection(i).Value = "Hello World"
End If
'search button
If objCollection(i).Type = "submit" Then
Set objSearchBnt = objCollection(i)
End If
i = i + 1
Wend
objSearchBnt.Click
'Clean up
Set objSearchBnt = Nothing
Set objCollection = Nothing
Set ie = Nothing
'Give excel control over the status bar agian
Application.StatusBar = ""
End Sub
I have a function that loads a website prompting a user to login. This works on everyone's computers except one person and I cannot figure it out. I get a runtime error on the line Do Until ieApp.ReadyState = 4: DoEvents: Loop that reads "Automation error. The object invoked has disconnected from its clients."
Function Firewall_Login() As Boolean
Dim ieApp As Object
Dim ieDoc As Object
Dim ieTable As Object
Dim ieDocResult As Object
Dim start_time
Set ieApp = CreateObject("internetexplorer.application")
start_time = Now()
ieApp.Navigate "http://awebsite.com/"
Do While ieApp.ReadyState = 4: DoEvents: Loop
Do Until ieApp.ReadyState = 4: DoEvents: Loop 'errors here just on the one computer
Set ieDoc = ieApp.Document
...
'do some stuff
...
ieDoc.Close
Set ieDoc = Nothing
ieApp.Quit
Set ieApp = Nothing
Firewall_Login = True
End Function
Seems like the object ieApp simply loses the instance of IE and can't do anything. Anyone have any suggestions?
All users are on the same version of IE -- 11.0.9600.18816
This code is taken from my blog. The code loops through shell windows looking to match the title bar which for IE will be the url. This way the reference is reacquired. Sometimes the reference can be lost due to a change of security zone etc.
Option Explicit
'* Tools - References
'* MSHTML Microsoft HTML Object Library C:\Windows\SysWOW64\mshtml.tlb
'* SHDocVw Microsoft Internet Controls C:\Windows\SysWOW64\ieframe.dll
'* Shell32 Microsoft Shell Controls And Automation C:\Windows\SysWOW64\shell32.dll
Private Function ReacquireInternetExplorer(ByVal sMatch As String) As Object
Dim oShell As Shell32.Shell: Set oShell = New Shell32.Shell
Dim wins As Object: Set wins = oShell.Windows
Dim winLoop As Variant
For Each winLoop In oShell.Windows
If "C:\Program Files (x86)\Internet Explorer\IEXPLORE.EXE" = winLoop.FullName Then
Dim sFile2 As String
sFile2 = "file:///" & VBA.Replace(sMatch, "\", "/")
If StrComp(sFile2, winLoop.LocationURL, vbTextCompare) = 0 Then
Set ReacquireInternetExplorer = winLoop.Application
GoTo SingleExit
End If
End If
Next
SingleExit:
End Function
as title says i am having an error at htdoc.all.verificationcode.Value = otp
it says Run-time error '438':
Object doesn't support this property or method
i have spent an afternoon trying to find what is wrong with it and i really hope that you guys could help me out.
Dim HTMLDoc As HTMLDocument
Dim htdoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub login()
Dim username As Range
Dim password As Range
Dim otp As Range
Dim myValue As Variant
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
MyURL = "XXXXXXXXXXXXXXXXXXXXXX"
Set MyBrowser = New InternetExplorer
MyBrowser.silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Set username = Range("B1")
Set password = Range("B2")
Set otp = Range("B3")
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
HTMLDoc.all.UserId.Value = username
HTMLDoc.all.password.Value = password
For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
MyURL2 = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
MyBrowser.silent = True
MyBrowser.navigate MyURL2
MyBrowser.Visible = True
myValue = InputBox("Enter OTP")
Range("B3").Value = myValue
Application.Wait (Now + TimeValue("0:00:10"))
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set htdoc = MyBrowser.document
htdoc.all.verificationcode.Value = otp
For Each MyHTML_Element In htdoc.getElementsByTagName("input")
If MyHTML_Element.Type = "btnobj" Then MyHTML_Element.Click: Exit For
Next
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
HTML in the webpage for the form is
<input name="verficationcode" id="verficationcode" type="password" size="18" maxlength="16" autocomplete="off">
<input name="btnobj" class="inputbutton" id="submitButton" onclick="checkSubmit(this);" type="button" value="Submit">
OK. That looks like a good start. You are going to a page, inputting some values and clicking Submit>. You have not set MyBrowser.visible to False so I'm assuming that you can see this going on.
The first thing you need is to wait while MyBrowser loads the page after you .click submit>. You will need to wait every time you go to a new page; My favorite is to put all of the waiting into a single line like this.
MyHTML_Element.Click
Do While (MyBrowser.Busy Or MyBrowser.readyState <> READYSTATE_COMPLETE): DoEvents: Loop
When you have that new page, you need to locate your OTP and store it in a variable. Look at the HTML behind the new page. You might see something like this:
<div id='One_Time_Password'>
47665489_29751678
</div>
You can put this into a variable you have previously declared like this.
dim myOTP as string
myOTP = MyBrowser.getElementsById("One_Time_Password").innerText
Now you have the password stored and you can do something with it.