VBA IE与大型表单的交互

时间:2018-06-26 03:30:16

标签: html vba internet-explorer webforms

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

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

Automate This

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

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

通过工作流中的其他一些字段/按钮,我获得了以下代码片段,这些代码片段可以成功运行,但不能在此处运行。

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分钟。我对此感到非常满意,即使(如上所述),我一直使用sendkey绝对不是最佳实践。

代码标记得很好,但是请让我知道我的逻辑是否不清楚。

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

1 个答案:

答案 0 :(得分:1)

一般观察:

我仅基于上面提供的内容就此提出建议时会有些谨慎。感觉好像太多了,我看不到。我正在假设您不能共享URL。

那么,您是否要按一下并输入数字,然后移动到下一行,或者HTML重复自身?我注意到上面较大的HTML部分具有input标记的元素,但每列只有1个,并且整个部分是行索引1,我认为它是第一行(text: lineNumber($index())">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判断这是否适用。