Run VBA automation for pulling internetexplorer source data in background - vba

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

Related

Using current instance of Internet Explorer for GetObject

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

Printing from SAP via VBA

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

Excel VBA multiple For loop not working

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

VBA open IE as invisible is not working

I am trying to open IE in background as below, but after 2 or 3 pages navigation it is taking more time to navigate and it moving in the loop
For k= 2 to lr
check_w:
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate Sheets("sheet1").Range("E" & k).Value
ie.Visible = False
Application.Wait (Now() + TimeValue("00:00:03"))
check_webpage:
Set BDoc = Nothing
Web_app_Title = Sheets("sheet1").Range("E" & k).Value
search_WEB_APP_URL
If BDoc Is Nothing Then
If ie Is Nothing Then
Application.Wait (Now() + TimeValue("00:00:03"))
GoTo check_w
Else
GoTo check_webpage
End If
End If
next k
A new IE-instance is created by in every iteration of your loop.
Set ie.visible = True for testing or open a Windows Task Manager, and you see what i mean.
So, quite simply, create the IE-object once before entering the loop. After finishing the loop, quit it before setting ie = Nothing.
Set ie = CreateObject("InternetExplorer.Application")
For k= 2 to lr
ie.navigate Sheets("sheet1").Range("E" & k).Value
....
Next k
ie.quit
Set ie = nothing
Should your experience problems with your IE-object getting dropped (for whatever reason), then, by any means, you can still wrap something like
If ie = Nothing Then Set ie = CreateObject("InternetExplorer.Application")
inside the loop.
Hint: instead of Application.Wait (Now() + TimeValue("00:00:03")) I used something like While ie.busy = True in Powershell - not sure if that applies in VBA too.
EDIT: Do While ie.ReadyState <> 4 : Loop

Copy and Paste contents from another workbook into current workbook

I have some code that downloads an excel file from the web. I need it to copy and paste its contents into my current workbook, but I get the "Subscript out of range" error. Code is below, and thanks in advance!
Sub dwnld()
Set IE = New SHDocVw.InternetExplorer
IE.Visible = True
IE.navigate "http://broomfield.flatironslibrary.org/"
While IE.Busy
DoEvents
Wend
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
IE.document.getElementsByClassName("hidden-xs header-button header-primary")(0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.document.getElementById("username").Value = "user"
IE.document.getElementById("password").Value = "pass"
IE.document.getElementsByClassName("btn btn-primary extraModalButton")(0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.navigate ("http://broomfield.flatironslibrary.org/MyAccount/CheckedOut?exportToExcel")
Application.Wait (Now + #12:00:02 AM#)
Application.SendKeys ("%o")
Application.Wait (Now + #12:00:05 AM#)
Call CopyingRange
End Sub
Copying Range Code:
Sub CopyingRange()
Workbooks("CheckedOutItems").Sheets("Checked Out").Range("A3:E62").Copy Range("B2")
End Sub
Please try this code below for CopyingRange
Sub CopyingRange()
Workbooks("CheckedOutItems").Sheets("Checked Out").Range("A3:E62").Copy ThisWorkBook.ActiveSheet.Range("B2")
End Sub
Good luck!