在后台运行VBA automation以提取internetexplorer源数据

我在一家发动机维修部门工作，对于我们的许多大型项目（即柴油发动机改造），我们必须通过库存内部网站申请大量零件。我们所有的零件都有一个指定的标识/目录号。不幸的是，该网站只允许您一次搜索一个零件。我创建这个宏是为了加快这个过程，并检查我们的库存中我输入到电子表格中的所有目录号

我在VBA中编写了一个宏，可以访问该站点，使用目录号（我在工作表的a列中输入）并将其插入搜索资源清册页面。然后，我的宏将检索零件描述、制造商零件号、可用编号、订单编号，并将其返回到我的电子表格中

为了使这个宏正常工作，我几乎不得不让我的计算机独自工作，直到整个过程完成（即，不打开任何新窗口，不最小化internet explorer打开的宏…）

我想知道是否有任何方法可以使它，这样我就可以使用我的电脑，而这个宏正在运行它的东西

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

---

这仅在IE窗口中完成，您可以使用您的计算机吗

'
' 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

'
'Do IE wait:正在等待IE查询返回：
“投入：
“objIe:IE对象
'
函数sofdoitewait（ByVal objIe）
While（objIe.Busy或objIe.readyState 4）
多芬特
温德
sofdoitewait=1
端函数
子sof20160137ICSsearch（）
像物体一样长
设置IE=CreateObject（“InternetExplorer.Application”）
可见=真实
'转到此网页！
即“导航”http://dd2.deepwater.com/t-sso-v206/sso/logon.aspx?baseurl=http://dd2.deepwater.com/ics/home.aspx"
'检查与网页循环的连接是否良好！
沙发
“等窗户打开！
'Application.Wait（现在+时间值（“0:00:01”））
“即可见=真实
'发送登录信息
'Application.Wait（现在+时间值（“0:00:01”））
SendKeys“输入用户名”，True
SendKeys“{TAB}”，真
SendKeys“输入密码”，True
'Application.Wait（现在+时间值（“0:00:01”））
SendKeys“{Enter}”，真
沙发
'
'现在我们已登录，请转到搜索页面：
'
即“导航”http://dd2.deepwater.com/ics/stocksearch.aspx"
沙发
'
范围（“A2”）。选择
iRow=ActiveCell.Row
'
'转到此网页以获取搜索资源清册（也是搜索循环的开始）！
'
做
'Application.Wait（现在+时间值（“0:00:02”））
'输入ICN编号
'Application.Wait（现在+时间值（“0:00:02”））
'
'是否搜索ActiveCell的值：
'
IE.Document.getElementById（“ctl05_TextBoxSCN”）。值=范围（“A”和iRow）
'Application.Wait（现在+时间值（“0:00:02”））
SendKeys“{Enter}”，真
沙发
'
'提取ICS结果
'Application.Wait（现在+时间值（“0:00:02”））
'
范围（“B”&iRow）=IE.Document.getElementById（“ctl05\U LabelPartNumber”）.innerText
范围（“C”&iRow）=IE.Document.getElementById（“ctl05_LabelDescription”）.innerText
范围（“D”&iRow）=IE.Document.getElementById（“ctl05_LabelUsableQty”）.innerText
范围（“E”&iRow）=IE.Document.getElementById（“ctl05_LabelOnOrderQuantity”）.innerText
范围（“A”&iRow）。选择
ActiveCell.Offset（1，0）。选择
iRow=ActiveCell.Row
如果范围（“A”&iRow）.Value=”“，则
退出Do
其他的
多芬特
如果结束
环
端接头

如果我们使用“SendKeys”方法，系统将不允许您工作。。相反，您可以找到您的站点用户名和密码输入框ID或名称以及下面的使用代码

IE.Document.getElementByID("YourIDID").value = UserName
IE.Document.getelementByID("YouPWDID").vlaue = PWD
IE.Document.getelementByID("ButtonID").click

通过使用这种方式，excel和其他应用程序之间没有依赖关系，因此您可以使用您的系统

如果您使用send键，它可能会在任何地方而不是在输入框中键入