【问题标题】:VBA IE interaction with a large formVBA IE与大表单交互
【发布时间】:2018-07-17 00:35:51
【问题描述】:

编辑:请参阅下面的更新。请参阅下面的“已完成”代码,它可以成功运行但使用非最佳实践。

我有一个通过供应商门户网站提供的大型表格,我正在努力使用 excel 中的数据自动填写(从数据仓库中提取,这部分很容易)。我正在尝试将所有字段的数据放入 (001)(Item)、(001)(GTIN)、(002)(Item) 等。

具体来说,这是我正在使用的网站代码:

<tr id="0lineDetailheader" data-bind="attr: {'id': $index() + 'lineDetailheader'}">
                    <!-- ko if: $parent.showExpColAll --><!-- /ko -->
                    <td>
                        <input type="checkbox" data-bind="checked: chkSelected">
                        <div style="margin-top: -20px; margin-left: -21px; position: absolute;" data-bind="style: { marginLeft: $parent.showExpColAll() ? '-45px' : '-21px', position: 'absolute', marginTop: '-20px' }, visible: hasError()">
                            <i title="Line has at least 1 error." class="fa fa-asterisk" style="color: rgb(204, 0, 0); cursor: pointer;">
                            </i>
                        </div>
                    </td>
                    <td>
                        <span data-bind="text: lineNumber($index())">001</span>
                    </td>
                    <td>
                        <input title="Item" class="form-control" onkeypress="return ValidateNum();" type="text" maxlength="9" data-bind="value: ItemNumber, readOnly: lineProtected">
                    </td>
                    <td>
                        <input title="GTIN" class="form-control" onkeypress="return ValidateNum();" type="text" maxlength="14" data-bind="value: GTIN, readOnly: lineProtected">
                        <span class="pull-right" data-bind="text: GTINlabel"></span>
                    </td>
                    <td>
                        <input title="Supplier Stock #: null" class="form-control" id="VndrStk" onkeypress="return validateAlphaNumPlus()" type="text" maxlength="45" data-bind="attr: { title: 'Supplier Stock #: ' + SupplierStockNumber()}, value: SupplierStockNumber, readOnly: lineProtected">
                    </td>
                    <td>
                        <input name="InvoiceQuantity" title="Invoice Quantity" class="form-control" onkeypress="return validateFloatKeyPress(this, event)" type="text" maxlength="9" data-bind="value: QtyInvoiced">
                    </td>
                    <td>
                        <input title="Selling Unit" class="form-control" onkeypress="return ValidateNum();" type="text" maxlength="9" data-bind="value: SellingUnits, readOnly: lineProtected">
                    </td>
                    <td>
                        <input title="Item Cost" class="form-control" onkeypress="return validateFloatKeyPress(this, event)" type="text" maxlength="9" data-bind="value: UnitPrice, readOnly: costProtected">
                    </td>
                    <td class="text-right">
                        <span title="Extended Cost" data-bind="text: ExtendedCost">0.00</span>
                    </td>
                    <td class="text-right">
                        <span title="Line Amount" data-bind="text: LineAmount">0.00</span>
                    </td>
                </tr>

我特别想在 0lineDetailheader 等中定位项目字段。

<input title="Item" class="form-control" onkeypress="return ValidateNum();" type="text" maxlength="9" data-bind="value: ItemNumber, readOnly: lineProtected">

通过工作流程中的其他一些字段/按钮,我让下面的 sn-ps 成功工作,但不是在这里。

Set ElementCol = IE.document.getElementsByClassName("lineDetailsHeader")
    ElementCol.Item(0).Select

With IE.document
    .all("InvoiceNbr").Value = ws.Range("C3").Value
    .all("invoiceDate").Value = ws.Range("C4").Value
    .all("shipDate").Value = ws.Range("C5").Value
End With

我也尝试使用sendkeys,效率极低,但我什至无法到达字段:/

我怀疑这个解决方案对于更精通 HTML 或 Java 的人来说是显而易见的,但可惜那不是我。

编辑: 更新 1 05.54 6/26/18

感谢下面的回复,我已经进入了这个领域。仍然不确定如何通过索引在 001、002 等行之间进行迭代。我正在使用的完整代码如下。我在某些区域使用 sendkey,因为 Web 表单旁边有这些红色星号,除非它注册完成,而且我不知道如何用“真实”代码触发它。

Public Sub WebFiller()

'Some definitions
Dim i As Long
Dim HWNDSrc As Long


'Set up workbook
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Invoice")

'Open Retail Link
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate REDACTED

'Let website load
While IE.ReadyState <> 4
    DoEvents
Wend

'Input store value
With IE.document
    .all("inputStore").Value = ws.Range("C1").Value
    .all("inputStore").Focus
    .all("inputStore").Select
End With

'The section only updates once it recognizes that values have been input. This seems to get force that interaction. It is definitely not best prcatice though.
HWNDSrc = IE.HWND
SetForegroundWindow HWNDSrc
Application.SendKeys "{Tab}", True
Application.Wait (Now + TimeValue("0:00:02"))

'Finish the button clicks on the first page, giving it appropriate refresh time.
Set ElementCol = IE.document.getElementsByClassName("btn btn-primary")
    ElementCol.Item(0).Click
Application.Wait (Now + TimeValue("0:00:02"))
Set ElementCol = IE.document.getElementsByClassName("btn btn-primary pull-right")
    ElementCol.Item(0).Click
Application.Wait (Now + TimeValue("0:00:02"))

'Let website load
While IE.ReadyState <> 4
    DoEvents
Wend

'Fill in the info at the top of the page
HWNDSrc = IE.HWND
SetForegroundWindow HWNDSrc
With IE.document
    .all("InvoiceNbr").Value = ws.Range("C3").Value
    .all("invoiceDate").Value = ws.Range("C4").Value
    .all("shipDate").Value = ws.Range("C5").Value
    .all("InvoiceNbr").Select
End With
Application.SendKeys "{Tab}", True
Application.Wait (Now + TimeValue("0:00:02"))

'Add the necessary number of rows
For i = 1 To ws.Range("C7").Value - 1
Set ElementCol = IE.document.getElementsByClassName("fa fa-plus fa-lg")
    ElementCol.Item(0).Click
Next i

'start first line "Index 0"
With IE.document
    .querySelector("input[title='Item']").Value = ws.Range("B12").Value
    .querySelector("input[title='GTIN']").Value = ws.Range("C12").Value
    .querySelector("input[title='Invoice Quantity']").Value = ws.Range("E12").Value
    .querySelector("input[title='Item Cost']").Value = ws.Range("G12").Value
    .querySelector("input[title='Item Cost']").FireEvent "onkeypress"
End With

'start second line "Index 1"
With IE.document
    .querySelector("input[title='Item']").Value = ws.Range("B15").Value
    'etc etc but this doens't work
End With
End Sub

编辑 7.16.18(最后更新): 这是完整的代码工作。它通过 OLAP 多维数据集连接到一些数据透视表,因此如果您尝试复制它,您可能必须更改与切片器交互的方式。

数据透视表上有以下代码:

Private Sub Worksheet_PivotTableUpdate _
    (ByVal Target As PivotTable)
    ' first remove filter
    Sheets("Invoice").Range("$E$11:$E$43").AutoFilter Field:=1
    ' then apply it again
    Sheets("Invoice").Range("$E$11:$E$43").AutoFilter Field:=1, Criteria1:="<>0"
End Sub

这会在预先格式化的页面上创建一个视觉过滤器,以模拟“发票”的创建(如果必须进行手动输入)。如果您使用的是列/行、索引/匹配/匹配、vlookup/hlookup 类型的函数,这是将特殊过滤器应用于列表的好方法。

主发票标签具有此代码。供应商的门户有一个提交文件的列表,所以我插入了这个清单/验证表来创建一个工作流。给定要“审查”的发票列表,宏循环遍历它们,检查是否已提交,发票总额是否符合预期,是否不是信用发票,需要单独处理。平均每张发票大约需要 75 秒,低于执行此操作的员工的 8 分钟左右。我对此非常满意,即使(如上所述)我一直使用 sendkeys,这绝对不是最佳实践。

代码标记得很好,但如果我的逻辑不清楚,请告诉我。

Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal HWND As LongPtr) As LongPtr


Public Sub InvoiceFiller()
'Purpose: To expedite WebEDI experience. Manual input takes too long.

'Some definitions
Dim i, r As Long
Dim lRow1, lRow2 As Long
Dim c As Range
Dim HWNDSrc As Long 'had to use sendkeys, couldn't figure out how else to trigger certain parts
Dim ws As Worksheet 'this is the invoice worksheet
Dim cs As Worksheet 'this is the checklist worksheet
Dim vs As Worksheet 'this is the validation against retail link's database
Dim cm As Worksheet 'this is the main cube report. All slicers affect both cubes
Dim wb As Workbook
Dim IE As Object
Dim SliceArr As Variant
Dim SliceVal As Variant

'Set up workbook shortcuts
Set wb = ThisWorkbook
Set ws = wb.Sheets("Invoice")
Set cs = wb.Sheets("Checklist")
Set vs = wb.Sheets("Validation")
Set cm = wb.Sheets("CUBE_MAIN")

''''''''''''''''''''''''''''''''''''''
'Start of Checklist component
'This sets up the ability to loop a range of invoices, referencing against the validation tab

'Copy tickets to the checklist page
lRow1 = cm.Cells(Rows.Count, 2).End(xlUp).Row - 1
lRow2 = cs.Cells(Rows.Count, 1).End(xlUp).Row

'First copy the tickets
cm.Range(cm.Cells(8, 1), cm.Cells(lRow1, 1)).Copy
cs.Range(cs.Cells(lRow2 + 1, 1), cs.Cells(lRow2 + 1 + lRow1 - 8, 1)).PasteSpecial xlPasteValues
'Next copy the dates
cm.Range(cm.Cells(8, 4), cm.Cells(lRow1, 4)).Copy
cs.Range(cs.Cells(lRow2 + 1, 2), cs.Cells(lRow2 + 1 + lRow1 - 8, 2)).PasteSpecial xlPasteValues
'Then copy the stores
cm.Range(cm.Cells(8, 3), cm.Cells(lRow1, 3)).Copy
cs.Range(cs.Cells(lRow2 + 1, 3), cs.Cells(lRow2 + 1 + lRow1 - 8, 3)).PasteSpecial xlPasteValues

'Trim the store data
For Each c In cs.Range(cs.Cells(lRow2 + 1, 3), cs.Cells(lRow2 + 1 + lRow1 - 8, 3))
    c.Value = Right(c.Value, 4)
Next c
'Apply the vlookup
For Each c In cs.Range(cs.Cells(lRow2 + 1, 4), cs.Cells(lRow2 + 1 + lRow1 - 8, 4))
    c.Formula = "=+VLOOKUP(C" & c.Row & ",'Walmart Table'!A:B,2,FALSE)"
Next c
ws.Activate

''''''''''''''''''''''''''''''''''''''
'Start of Slicer Looping component

For r = lRow2 + 1 To lRow2 + 1 + lRow1 - 8
wb.SlicerCaches("Slicer_Ticket_Number").VisibleSlicerItemsList = Array("[Sales].[Ticket Number].&[" & cs.Range("A" & r).Value & "]")
Application.Wait (Now + TimeValue("0:00:01")) 'This is mainly for visual satisfaction.

'Run some qualifiers before uploading
If ws.Range("D3").Value = "Does not tie-out" Then cs.Range("E" & r).Value = ws.Range("D3").Value
If ws.Range("D3").Value = "Credit memo" Then cs.Range("E" & r).Value = ws.Range("D3").Value
If ws.Range("D3").Value = "Already in WebEDI" Then cs.Range("E" & r).Value = ws.Range("D3").Value

'If no reason not to, then go ahead an upload
If ws.Range("D3").Value = "Okay to upload" Then

''''''''''''''''''''''''''''''''''''''
'Start of WebEDI component

'Open website
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate ***OMMITTED***

'Let website load
While IE.ReadyState <> 4
    DoEvents
Wend

'Input store value
With IE.document
    .all("inputStore").Value = ws.Range("C1").Value
    .all("inputStore").Focus
    .all("inputStore").Select
End With

'The section only updates once it recognizes that values have been input. This seems to get force that interaction. It is definitely not best prcatice though.
HWNDSrc = IE.HWND
SetForegroundWindow HWNDSrc
Application.SendKeys "{Tab}", True
Application.Wait (Now + TimeValue("0:00:02"))

'Finish the button clicks on the first page, giving it appropriate refresh time.
Set ElementCol = IE.document.getElementsByClassName("btn btn-primary")
    ElementCol.Item(0).Click
Application.Wait (Now + TimeValue("0:00:02"))
Set ElementCol = IE.document.getElementsByClassName("btn btn-primary pull-right")
    ElementCol.Item(0).Click
Application.Wait (Now + TimeValue("0:00:02"))

'Let website load
While IE.ReadyState <> 4
    DoEvents
Wend

'Give IE a chance to un-stuck
Application.Wait (Now + TimeValue("0:00:03"))

'Fill in the info at the top of the page
HWNDSrc = IE.HWND
SetForegroundWindow HWNDSrc
With IE.document
    .all("InvoiceNbr").Value = ws.Range("C3").Value
    .all("invoiceDate").Value = ws.Range("C4").Value
    .all("shipDate").Value = ws.Range("C5").Value
    .all("InvoiceNbr").Select
End With
Application.SendKeys "{Tab}", True
Application.Wait (Now + TimeValue("0:00:02"))

'Add the necessary number of rows
For i = 1 To ws.Range("C7").Value - 1
Set ElementCol = IE.document.getElementsByClassName("fa fa-plus fa-lg")
    ElementCol.Item(0).Click
Next i

With IE.document
    .querySelector("input[title='Item']").Value = 0
    .querySelector("input[title='Item']").Select
End With

For i = 12 To 43
    If ws.Range("B" & i).EntireRow.Hidden = False Then
    Application.SendKeys ws.Range("B" & i).Value, True
    Application.SendKeys "{Tab}", True
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys ws.Range("C" & i).Value, True
    Application.SendKeys "{Tab}", True
    Application.SendKeys "{Tab}", True
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys ws.Range("E" & i).Value, True
    Application.SendKeys "{Tab}", True
    Application.SendKeys "{Tab}", True
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys ws.Range("G" & i).Value, True
    Application.SendKeys "{Tab}", True
    Application.SendKeys "{Tab}", True
    Application.Wait (Now + TimeValue("0:00:01"))
    End If
Next i

'Submit Invoice
Set ElementCol = IE.document.getElementsByClassName("fa fa-arrow-up fa-lg")
    ElementCol.Item(0).Click

'Give IE a chance to un-stuck
Application.Wait (Now + TimeValue("0:00:01"))

'Let website load
While IE.ReadyState <> 4
    DoEvents
Wend

'Give IE a chance to un-stuck
Application.Wait (Now + TimeValue("0:00:05"))

'Close IE
IE.Quit
Set IE = Nothing

'End of WebEDI component
''''''''''''''''''''''''''''''''''''''

cs.Range("E" & r).Value = "Uploaded!"

'Go to next ticket and repeat the evaluation sequence
End If
Next r

'End of Slicer Looping component
''''''''''''''''''''''''''''''''''''''

End Sub

【问题讨论】:

  • 这是内部网址吗?
  • attr 绑定显然是一种为关联的 DOM 元素设置任何属性值的通用方法,只要相应的模型属性更改,属性值就会自动更新。页面上是否有引用 $index() + 'lineDetailheader' 的 js 脚本?
  • QHarr,有那个索引脚本参考。虽然不知道怎么称呼它。这是供应商的发票门户,通过登录。
  • 我也不确定,但将数据输入不同行的关键可能在于执行该函数,即执行该函数时索引可能会增加,然后您填充下一行。你能显示与脚本相关的 HTML 吗?

标签: html vba internet-explorer webforms


【解决方案1】:

一般观察:

我对仅根据上面提供的内容提出建议有点谨慎。感觉有太多我看不到了。我正在假设您无法共享 URL。

那么,您是否按了某些东西并输入了数字,然后它会移动到下一行,还是 HTML 会重复自己?我注意到上面较大的 HTML 部分有 input 标记的元素,但每列只有 1 个,整个部分是行索引 1,我假设它是顶行 (text: lineNumber($index())"&gt;001) –


10 岁的初学者:

作为 10 的开始,您可以使用 CSS selectors 代替 Item, GTIN, Stock, Invoice qty, Selling Unit,Item Cost

.document.querySelector("input[title='Item']")
.document.querySelector("input[title='GTIN']")
.document.querySelector("#VndrStk")
.document.querySelector("input[title='Invoice Quantity']")
.document.querySelector("input[title='Selling Unit']")
.document.querySelector("input[title='Item Cost']")

.querySelectordocument 的一个方法,并在"" 中应用CSS 选择器。

如果重复这些项目,您可以使用 .querySelectorAll 方法返回具有匹配 CSS 模式的元素的 nodeList,然后通过索引访问来自该 nodeList 的项目。类似于你如何处理.getElementsByClassName 返回的集合,例如,除了你不能使用For Each Loop 来遍历,而是遍历它的.Length


onkeypress事件

这些元素似乎具有关联的onkeypress 事件。

因此您可能需要在设置值后模拟这些事件,例如

.document.querySelector("input[title='Item']").Value = 10 
.document.querySelector("input[title='Item']").FireEvent "onkeypress"

在尝试分配之前,您可能还需要在元素上使用.Focus


一些 CSS 选择器示例说明:

  1. input[title='Item']

这表示带有input 标记的元素具有属性title,其值为'item'[] 表示属性。

  1. #VndrStk

这表示 id 为 VndrStk 的元素。 # 表示 id。


.querySelectorAllnodeList

多个元素使用.querySelectorAll方法和语法可能是:

.querySelectorAll("input[title='Item']").item(1).Value = ws.Range("B15").Value 

.querySelectorAll("input[title='Item']")(1).Value = ws.Range("B15").Value

使用索引 1 的示例。我无法从上面的 HTML 中判断这是否适用。

【讨论】:

  • 非常感谢您的洞察力。我将尝试在我的代码中使用它。
  • 首先,您的回复非常有条理。 .document.querySelector 输入运行良好。我正在尝试将其用于其余代码,但不确定如何。我还尝试使用该“onkeypress”来进一步替换 SendKeys 的使用,但我无法让它工作。
  • 索引一将类似于:.querySelectorAll("input[title='Item']").item(1).Value = ws.Range("B15").Value
  • 这是假设元素以这种方式存在。我不能从提供的 html 中分辨出来。替代语法可以是 .querySelectorAll("input[title='Item']")(1).Value = ws.Range("B15").Value
  • 嘿,我在上面发布了我的完整代码。回想起来,我是如此接近可交付成果,我强迫自己坚持使用 sendkeys。整个过程完美无缺,除非第二个网页需要超过 9 秒才能加载,此时它会出错。您的帮助非常宝贵,谢谢!
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2019-03-13
  • 1970-01-01
  • 1970-01-01
  • 2012-07-24
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多