在网站仍在加载时自动执行网站数据输入时出错

时间:2019-03-24 07:07:20

标签: excel vba web-scraping

我有一些代码,可以从ThisWorkbook的多个列中提取数据,并将其放在Internet Explorer中网站的各个字段中。单击 line1 (搜索按钮)后,网站即会加载。然后,代码会在 line2 处单击复选框,从而引发错误,因为如果网站仍在加载,则还没有复选框。 (我认为该网站建立在Sharepoint上,并且编码不正确。)

是否有代码在2-3秒后重复第2行并在出现错误时继续继续执行?我尝试了错误处理程序来重复代码,但是没有用。

    Sub CSA_Upload()

        Dim test1 As Long, test2 As Long
        test1 = Timer

        Dim n As Long
        Range("A1").Select
        n = Selection.End(xlDown).Row
        ThisWorkbook.Sheets("Data").Range("A2:A" & n).Interior.ColorIndex = 0

        Dim IE As Object
        Dim doc As Object
        Dim htmlTable As htmlTable
        Set IE = New InternetExplorerMedium
        'Set IE = CreateObject("InternetExplorer.Application")
        IE.Visible = True

        'Navigate to CSA tool Home Page
        IE.navigate "https://csa.abcdefg.com/Collector_view.aspx/"

        'Wait till it loads
        Do While IE.Busy
            Application.Wait DateAdd("s", 1, Now)
        Loop

        Set doc = CreateObject("htmlfile")
        Set doc = IE.document

        'Enter Invoice Number in SearchBy box
        doc.getElementById("ContentPlaceHolder1_ddlSearch").Value = "[Inv Number]"

        Range("A1").Select

        'Count the number of rows in the data list
        Dim X As Long
        Range("A1").Select
        X = Selection.End(xlDown).Row

        'For each invoice number the loop starts here
        For rowNo = 2 To X
            ActiveCell.Offset(1).Select
            'Fill Blue colour in active processing invoice number cell
            ThisWorkbook.Sheets("Data").Range("A" & rowNo).Interior.ColorIndex = 37

            'Input the invoice number
            doc.getElementById("ContentPlaceHolder1_txtSearch").Value = ThisWorkbook.Sheets("Data").Range("A" & rowNo).Value

            'Click the Search button
    'This is the Line1
            doc.getElementById("ContentPlaceHolder1_search").Click

            'Wait till it loads
            Do While IE.Busy
                Application.Wait DateAdd("s", 5, Now)
            Loop

            'Checkbox select all
    'This is the Line2
            doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll").Click
            'Wait 3 seconds till it selects all the checkboxes
            Application.Wait DateAdd("s", 3, Now)

            'Enter rest of the data
            doc.getElementById("ContentPlaceHolder1_ddlaction").Value = ThisWorkbook.Sheets("Data").Range("B" & rowNo).Value        'Input Action
            doc.getElementById("ContentPlaceHolder1_txtToDoDate").Value = ThisWorkbook.Sheets("Data").Range("C" & rowNo).Value      'Input Action Date
            doc.getElementById("ContentPlaceHolder1_ddlstatus").Value = ThisWorkbook.Sheets("Data").Range("D" & rowNo).Value        'Input Root Cause
            doc.getElementById("ContentPlaceHolder1_txtcomments").Value = ThisWorkbook.Sheets("Data").Range("E" & rowNo).Value      'Input Comments
            doc.getElementById("ContentPlaceHolder1_btn_Comments").Click                                                            'Click Submit button

            Application.Wait DateAdd("s", 3, Now)

            'Hit enter on MessegeBox
            Application.SendKeys "{ENTER}"

            'Fill Green colour in the active cell when all entries are passed
            ThisWorkbook.Sheets("Data").Range("A" & rowNo).Interior.ColorIndex = 35

        Next 'Proceed to next invoice number

        IE.Quit 'Quit Internet explorer
        test2 = Timer
        MsgBox (X - 1) & " Invoices have been updated and it took " & Format((test2 - test1) / 86400, "hh:mm:ss") & " Seconds."

    End Sub

3 个答案:

答案 0 :(得分:0)

于2019-03-25修订

我认为是因为doc被更改而引发了错误。

重写

' This is the Line2
    doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll").Click
    'Wait 3 seconds till it selects all the checkboxes
    Application.Wait DateAdd("s", 3, Now)

' This is the Line2 
    application.wait Application.Wait DateAdd("s", 1, Now)
    set doc = IE.document
    doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll").Click
    'Wait 3 seconds till it selects all the checkboxes
    Application.Wait DateAdd("s", 3, Now)

可能有帮助。

答案 1 :(得分:0)

在每个.Navigate.Click之后使用适当的页面加载等待。

While ie.Busy Or ie.readyState < 4: DoEvents: Wend

此外,您可以将与计时相关的引发错误的元素包装在尝试设置对象引用的定时循环中

Dim t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 10

t = Timer
Do
    On Error Resume Next
    Set ele = doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll")
    On Error GoTo 0
    If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing

If Not ele Is Nothing Then
    ele.Click
End If

答案 2 :(得分:0)

我已在第1行之后的等待循环下方删除。

    'Wait till it loads
    Do While IE.Busy
        Application.Wait DateAdd("s", 5, Now)
    Loop

并在

之前添加了10秒等待时间Application.Wait DateAdd("s", 10, Now)的修复程序
    doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll").Click
    'Wait 3 seconds till it selects all the checkboxes
    Application.Wait DateAdd("s", 3, Now)

所以最后的代码如下,并且可以正常工作!

'This is the Line1
        doc.getElementById("ContentPlaceHolder1_search").Click

        'Checkbox select all
'This is the Line2
        Application.Wait DateAdd("s", 10, Now)
        doc.getElementById("ContentPlaceHolder1_GridView1_chkboxSelectAll").Click
        'Wait 3 seconds till it selects all the checkboxes
        Application.Wait DateAdd("s", 3, Now)