首页 > 解决方案 > VBA IE与大表单交互

问题描述

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

我通过供应商门户有一个大表格,我正在努力从 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 等中找到 item 字段。

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

使用工作流程中的其他一些字段/按钮,我得到了下面的代码片段成功地工作,但不是在这里。

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

标签: htmlvbainternet-explorerwebforms

解决方案


一般观察:

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

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


10人的首发:

作为 10 选择顶行元素的初学者,您可以将CSS 选择器用于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']")

.querySelector是一种方法,document并在"".

如果这些项目被重复,您可以使用该.querySelectorAll方法返回nodeList具有匹配 CSS 模式的元素,然后nodeList通过索引访问其中的项目。类似于你如何处理由返回的集合.getElementsByClassName,例如,除了你不能使用 aFor 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#表示身份证。


.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 中判断这是否适用。


推荐阅读