I am trying to use SendKeys to navigate & enter data with Internet Explorer. The first section of code has a loop during which the webpage (ending in .php) refreshes itself to get the entry in. As I'm using SendKeys once the browser is opened, I'm looking for a way to pause the script until the page is loaded and ready to receive input. I'm currently using a small time delay of 3 seconds which works well but if the browser lags, everything goes haywire.
So, is there anything that can facilitate this or at least allow me to use the GetObject command to set a current instance of Internet Explorer as an object.
AppActivate "Explorer"
Dim CCount As Integer
Dim DCount As Integer
Dim LCount As Integer
LCount = 1
CCount = 2
DCount = ActiveSheet.Range("O2").Value
Dim LoopP As Integer
LoopP = 1
For LoopP = 1 To DCount
SendKeys ActiveSheet.Range("A" & CCount).Value, True
SendKeys "{Tab}", True
SendKeys Format(ActiveSheet.Range("C" & CCount).Value, "#,###"), True
SendKeys "{Tab}", True
' Breakdown IF
If ActiveSheet.Range("K" & CCount).Value = 1 Then
SendKeys ActiveSheet.Range("D" & CCount).Value, True
Else
End If
SendKeys "{Tab}"
' Remark IF
If ActiveSheet.Range("L" & CCount).Value = 1 Then
SendKeys ActiveSheet.Range("E" & CCount).Value, True
Else
End If
SendKeys "{Tab}", True
SendKeys "{Enter}", True
CCount = CCount + 1
' While IE.Busy Or IE.readyState <> 4: DoEvents: Wend
' While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
' Do While IE.readyState <> 4: WScript.Sleep 100: Loop
Application.Wait (Now + TimeValue("0:00:01"))
Next LoopP
Related
I have a script I put together that completes bulk shipments in SAP via VBA. At the end of each completed shipment, I want SAP to print the completed page as confirmation.
Sub STOMacro()
Dim App, Connection, session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Set App = SapGuiAuto.GetScriptingEngine
Set Connection = App.Children(0)
Set session = Connection.Children(0)
If session Is Nothing Then
Set session = Connection.Children(Int(ses))
End If
If MsgBox("Are you sure you want to acknowledge these STOs?", vbYesNo, "Complete STOs?") = vbNo Then
Exit Sub
End If
OrderCounter = Range("A:A").Find("*", Range("A64999"), xlValues, xlWhole, xlByRows, xlPrevious).Row
For i = 1 To OrderCounter
Application.DisplayAlerts = False
STO = Range("A" & i).Value
Application.StatusBar = "Acknowledging STO " & i & " out of " & OrderCounter
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nzvmonitor"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtV-LOW").Text = "STOPrint"
session.findById("wnd[1]/usr/txtENAME-LOW").Text = ""
session.findById("wnd[1]/usr/txtV-LOW").CaretPosition = 14
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").Text = "" & STO & ""
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").SetFocus
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").CaretPosition = 10
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").currentCellColumn = ""
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").selectedRows = "0"
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").pressToolbarButton "RCPT"
session.findById("wnd[0]").sendVKey 3
session.findById("wnd[1]/usr/btnBUTTON_1").press
session.findById("wnd[1]").sendVKey 0
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").pressToolbarButton "&PRINT_BACK"
session.findById("wnd[1]").sendVKey 0
session.findById("wnd[1]").sendVKey 13
'This is where the print dialogue pops up but I can't interact with it
Next i
MsgBox ("All STOs acknowledged and printed.")
Application.StatusBar = ""
End Sub
I can get SAP to open the print dialogue box but the user still has to manually click "ok" in order to actually print the pages. This is a minor inconvenience but I was wondering if it could.
Print dialogue
If anything, I'm fine with just using SendKeys to make the print dialogue get {Enter} sent to it but I don't know how to make SAP hook onto the box to send that command.
For many years we have been using the following program code in a similar place:
. . .
dim Wshell as Object
set Wshell = CreateObject("WScript.Shell")
on error resume next
Do
bWindowFound = Wshell.AppActivate("Print")
Application.Wait (Now + TimeValue("0:00:01"))
Loop Until bWindowFound
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{ENTER}"
end if
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{TAB}{ENTER}"
end if
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{TAB}{TAB}{ENTER}"
end if
'It could be superfluous under certain circumstances.
session.findById("wnd[1]").Close
Application.Wait (Now + TimeValue("0:00:01"))
on error goto 0
. . .
However, since you can not know where the cursor is currently located, all possibilities are carried out. But if you know it, you could leave something out.
Regards,
ScriptMan
Hi I need help with this code I'm trying to extract data from this page https://finance.yahoo.com/quote/ADM.L/balance-sheet?p=ADM.L ,
but the problem is page is by default set to annual but I need quarterly values of total assets and total liabilities.
This code runs but most of the time it is picking annual values. Please suggest something what can I do.
Private Sub CommandButton3_Click()
'
Dim ie As Object
Set Rng = Range("A2:A50")
Set Row = Range(Rng.Offset(1, 0), Rng.Offset(1, 0).End(xlDown))
Set ie = CreateObject("InternetExplorer.Application")
With ie
'.Visible = False
For Each Row In Rng
.navigate "https://finance.yahoo.com/quote/" & Range("A" & Row.Row).Value & "/balance-sheet?p=" & Range("A" & Row.Row).Value
'Application.Wait (Now + TimeValue("0:00:02"))
While ie.readyState <> 4
Wend
Do While ie.Busy: DoEvents: Loop
Dim doc As HTMLDocument
Set doc = ie.document
doc.getElementsByClassName("P(0px) M(0px) C($actionBlue) Bd(0px) O(n)")(2).Click
Do While ie.Busy: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:05"))
Range("D" & Row.Row).Value = doc.getElementsByClassName("Fw(b) Fz(s) Ta(end)")(4).innerText
Range("E" & Row.Row).Value = doc.getElementsByClassName("Fw(b) Fz(s) Ta(end)")(12).innerText
Range("F" & Row.Row).Value = doc.getElementsByClassName("C($gray) Ta(end)")(0).innerText
Next Row
End With
ie.Quit
'
End Sub
This should be a good start for you to get going.
Sub DownloadData()
Set ie = CreateObject("InternetExplorer.application")
With ie
.Visible = True
.navigate "https://finance.yahoo.com/quote/ADM.L/balance-sheet?p=ADM.L"
' Wait for the page to fully load; you can't do anything if the page is not fully loaded
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set e = ie.Document.GetElementsByClassName("Fz(s) Fw(500) D(ib) Pend(15px) H(18px) C($finDarkLink):h Mend(15px)")(1)
e.Click
' Wait for the page to fully load; you can't do anything if the page is not fully loaded
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
End With
End Sub
Basically, 'Annual' is the default and you have to click the 'Quarterly' link, to get the quarterly data displayed. I believe yahoo used to have 2 different URLs for Annual and Quarterly. Now, apparently, they give you 2 links to click to toggle back and forth between the 2 frequencies of financial statements.
Do find below on the code fix. Do take note that Yahoo has updated the classname i.e. from "P(0px) M(0px) C($actionBlue) Bd(0px) O(n)" ==> "P(0px) M(0px) C($c-fuji-blue-1-b) Bd(0px) O(n)".
Private Sub CommandButton3_Click()
Dim ie As Object
Set Rng = Range("A2:A50")
Set row = Range(Rng.Offset(1, 0), Rng.Offset(1, 0).End(xlDown))
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
For Each row In Rng
.navigate "https://finance.yahoo.com/quote/" & Range("A" & row.row).Value & "/balance-sheet?p=" & Range("A" & row.row).Value
While ie.readyState <> 4
Wend
Do While ie.Busy: DoEvents: Loop
Dim doc As HTMLDocument
Set doc = ie.document
Set element = doc.getElementsByClassName("P(0px) M(0px) C($c-fuji-blue-1-b) Bd(0px) O(n)")(2)
element.Click
Do While ie.Busy: DoEvents: Loop
Range("D" & row.row).Value = doc.getElementsByClassName("Fw(b) Fz(s) Ta(end)")(4).innerText
Range("E" & row.row).Value = doc.getElementsByClassName("Fw(b) Fz(s) Ta(end)")(12).innerText
Range("F" & row.row).Value = doc.getElementsByClassName("C($gray) Ta(end)")(0).innerText
Next row
End With
ie.Quit
End Sub
It is not possible to extract Quarterly data from Yahoo using VBA.
Annual data can be extracted, but not quarterly.
I seem to be stuck in an weird issue. I have the Excel VBA code below to visit a website and enter a userID (from the userID column A in sheet 1) and retrieve the name of the user which shows up after hitting the submit button then continues with the rest of the userIDs.
Public Sub TEST()
TestPage = "http://test.com/"
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
Dim GetElem As Object
Dim GetElem2 As Object
IE.Visible = True
IE.navigate TestPage
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:04"))
Set Doc = IE.document
CurRow = Sheet1.UsedRange.Rows.Count
Do While CurRow > 0
Application.Wait (Now + TimeValue("0:00:4"))
'Find/Get the userID textbox and enter the current userID
For Each GetElem In Doc.getElementsByTagName("input")
If GetElem.ID = "query" Then 'I could just do getElementByID later
GetElem.Value = Sheet1.Range("A" & CurRow).Value
End If
Next
'Find and click the submit button
For Each GetElem2 In Doc.getElementsByTagName("button")
If GetElem2.Type = "submit" Then
GetElem2.Click
Application.Wait (Now + TimeValue("0:00:03"))
End If
Next
CurRow = CurRow - 1
Loop
End Sub
The problem is the code works only once. It enters the first userID into the text box and hits Submit. When it loops and tries to enter the next userID though, the code get stuck in a loop.
If I remove the entire 2nd For-Next loop it works (although it doesn't submit, it enters each of the userIDs in the text box).
On top of that, if I use the F8 debugging the code step by step, everything works fine. Only getting problems when fully running the code.:(
Public Sub TEST()
TestPage = "http://test.com/"
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
Dim GetElem As Object
Dim GetElem2 As Object
IE.Visible = True
IE.navigate TestPage
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:04"))
Set Doc = IE.document
CurRow = Sheet1.UsedRange.Rows.Count
For Each GetElem In Doc.getElementsByTagName("input")
If GetElem.ID = "query" Then 'I could just do getElementByID later
GetElem.Value = Sheet1.Range("A" & CurRow).Value
For Each GetElem2 In Doc.getElementsByTagName("button")
If GetElem2.Type = "submit" Then
GetElem2.Click
Application.Wait (Now + TimeValue("0:00:03"))
End If
Next GetElem2
End If
CurRow = CurRow + 1
Next GetElem
End Sub
I have a small piece of code which tried to search in a website and tells whether there are any results or not.
It works very good for me (#India) but not for my colleague (#US). He checked in 2 of his PCs but gets same error.
After I click on search button, ie.Document becomes totally blank, also ie.Document.ChildNodes.Length returns 0.
Sub iTest()
Call ProcessRecord("First_Name", "Middle_Name", "Last_Name", "1/1/2015")
End Sub
Private Function ProcessRecord(fName As String, mName As String, lName As String, dob As String) As Boolean
Dim results As String, idx%
Dim ie As New InternetExplorer
ie.Visible = True
Navigate ie, "http://ws.ocsd.org/ArrestWarrants/default.aspx"
Do While ie.Busy Or ie.ReadyState <> READYSTATE_COMPLETE
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Do While ie.Busy Or ie.Document.ReadyState <> "complete"
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
' fill values in webpage
ie.Document.getElementById("FirstName").Value = fName
ie.Document.getElementById("MiddleName").Value = mName
ie.Document.getElementById("LastName").Value = lName
ie.Document.getElementById("DOB").Value = dob
' click on search button
ie.Document.getElementById("btnSearch").Click
' wait for results
Do While ie.Busy Or ie.ReadyState <> READYSTATE_COMPLETE
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Do While ie.Busy Or ie.Document.ReadyState <> "complete"
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
' check results
results = ie.Document.getElementById("lblResults").innerText '<< It gives Object Required error here. Because ie.Document has no element after I click on search button.
If results = "No Results Found." Then
MsgBox "Not found", vbExclamation
Else
MsgBox "Found", vbExclamation
End If
ie.Quit
End Function
Have you tried the below?
Do While ie.Busy Or ie.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Appears to be working for me, might just be a delay in internet connection for your US friend.
I work in an engine maintenance department and for alot of our big projects (i.e. diesel engine rebuilds) we have to request alot of parts through our inventory intranet site. all of our parts have an assigned identification/catalog number. Unfortunately the site only lets you search for one part at a time. I created this macro to speed up the process and check our inventory for all catalog numbers I enter into the spreadsheet.
I wrote a macro in VBA that would access the site, use the catalog numbers (I have entered in the A-Column of my worksheet) and plug it into the search inventory page. My Macro would then retrieve the part description, manufacturer part number, number available, number on order and return it to my spreadsheet.
In order for this macro to work I pretty much have to leave my computer alone until the whole process is finished (i.e. no opening up any new windows, no minimizing the macro-opened internet explorer...)
I was wondering if there's any way to make it so that I can use my computer while this macro is running through its thing.
Sub ICSsearch()
Range("A2").Select
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'Go to this Web Page!
IE.navigate "http://dd2.deepwater.com/t-sso-v206/sso/logon.aspx?baseurl=http://dd2.deepwater.com/ics/home.aspx"
'Check for good connection to web page loop!
Do
If IE.readyState = 4 Then
IE.Visible = True
Exit Do
Else
DoEvents
End If
Loop
'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:01"))
IE.Visible = True
'Send logon information
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "ENTER USERNAME", True
SendKeys "{TAB}", True
SendKeys "ENTER PASSWORD", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{Enter}", True
'Go to this Web Page for Search Inventory (also start of search loop)!
Do
Application.Wait (Now + TimeValue("0:00:02"))
IE.navigate "http://dd2.deepwater.com/ics/stocksearch.aspx"
'Enter ICN number
Application.Wait (Now + TimeValue("0:00:02"))
IE.Document.getelementbyid("ctl05_TextBoxSCN").Value = Range("A" & (ActiveCell.Row))
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Enter}", True
'Extract ICS Results
Application.Wait (Now + TimeValue("0:00:02"))
Range("B" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelPartNumber").innerText
Range("C" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelDescription").innerText
Range("D" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelUsableQty").innerText
Range("E" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelOnOrderQuantity").innerText
Range("A" & (ActiveCell.Row)).Select
ActiveCell.Offset(1, 0).Select
If Range("A" & (ActiveCell.Row)).Value = "" Then
Exit Do
Else
DoEvents
End If
Loop
End Sub
If we using "SendKeys" Method system wont allow you to work.. Instead you can find out your site UserName and PassWord input box ids or Name and the use below code.
IE.Document.getElementByID("YourIDID").value = UserName
IE.Document.getelementByID("YouPWDID").vlaue = PWD
IE.Document.getelementByID("ButtonID").click
By using this way there is no dependency between excel and other applications so you can use your system.
If you use send key there is a possibility it can type anywhere instead of input box.
This is done in IE Window only, you can use your computer?
'
' Do IE wait: waiting for IE query return:
' inputs:
' objIe: IE object
'
Function sofDoIeWait(ByVal objIe)
While (objIe.Busy Or objIe.readyState <> 4)
DoEvents
Wend
sofDoIeWait = 1
End Function
Sub sof20160137ICSsearch()
Dim iRow As Long, IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'Go to this Web Page!
IE.navigate "http://dd2.deepwater.com/t-sso-v206/sso/logon.aspx?baseurl=http://dd2.deepwater.com/ics/home.aspx"
'Check for good connection to web page loop!
sofDoIeWait IE
'Wait for window to open!
' Application.Wait (Now + TimeValue("0:00:01"))
' IE.Visible = True
'Send logon information
' Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "ENTER USERNAME", True
SendKeys "{TAB}", True
SendKeys "ENTER PASSWORD", True
' Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{Enter}", True
sofDoIeWait IE
'
' now we are logged in, so go to the search page:
'
IE.navigate "http://dd2.deepwater.com/ics/stocksearch.aspx"
sofDoIeWait IE
'
Range("A2").Select
iRow = ActiveCell.Row
'
'Go to this Web Page for Search Inventory (also start of search loop)!
'
Do
'Application.Wait (Now + TimeValue("0:00:02"))
'Enter ICN number
'Application.Wait (Now + TimeValue("0:00:02"))
'
' do search the value of the ActiveCell:
'
IE.Document.getElementById("ctl05_TextBoxSCN").Value = Range("A" & iRow)
'Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Enter}", True
sofDoIeWait IE
'
'Extract ICS Results
'Application.Wait (Now + TimeValue("0:00:02"))
'
Range("B" & iRow) = IE.Document.getElementById("ctl05_LabelPartNumber").innerText
Range("C" & iRow) = IE.Document.getElementById("ctl05_LabelDescription").innerText
Range("D" & iRow) = IE.Document.getElementById("ctl05_LabelUsableQty").innerText
Range("E" & iRow) = IE.Document.getElementById("ctl05_LabelOnOrderQuantity").innerText
Range("A" & iRow).Select
ActiveCell.Offset(1, 0).Select
iRow = ActiveCell.Row
If Range("A" & iRow).Value = "" Then
Exit Do
Else
DoEvents
End If
Loop
End Sub