Question

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

我在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

Answer 1

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

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

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

如果您使用发送密钥，则可以在任何地方输入而不是输入框。

Answer 2

这只在IE Window中完成，你可以使用你的电脑吗？

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

运行VBA自动化以在后台提取internetexplorer源数据

2 个答案: