excel - VBA 自动执行网页抓取进入单元格

Question

我在 Excel 中有一个数字列表，我想自动执行将它们逐一输入网页的过程。

我当前使用的代码登录该网站，输入用户名信息和密码。按回车键。然后转到下一个屏幕，我在其中单击“启动”。

接下来，它进入下一个屏幕，程序在其中单击历史记录按钮。然后返回到 Excel(A 列)并取出第一个数字并输入“此处的数字”，然后单击 Enter。这将我带到一个包含大量信息的页面，然后我将其复制并粘贴回 Excel 中。

我再次针对这些因素运行了程序。

但是，我相信我的代码应该移动到列中的下一个数字(即，首先对单元格 A3 执行上述步骤，然后对单元格 A4 等执行上述步骤)，但不是。

下面是我的代码:

Option Explicit

Sub _NumberFix()

Dim IE As Object
Dim IeDoc As Object
Dim aInput As Object
Dim eInput As Object
Dim svalue1 As Object
Dim elems As Object
Dim t As Date
Dim i As Long, lastrow As Long
Dim ws As Worksheet, wks As Excel.Worksheet
Dim NewName As String
Dim sheet As Worksheet
Dim duplicate As Boolean

Const MAXWAIT_sec As Long = 10

Set ws = Sheets("VALUES")

Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.Navigate ("http://mywebsite.com/")

    Do While IE.busy: DoEvents: Loop

Set IeDoc = IE.document

'Enters username and password
    With IeDoc.all
        .UserName.Value = "userr"
        .Password.Value = "password"
    End With

    With IE.document.forms("signingin")
        .document.forms(0).submit
    End With


Set IeDoc = IE.document ' set new page source

    t = Timer

    Do
        On Error Resume Next
        Set elems = IeDoc.queryselector("input[value=Initiate]")
        On Error GoTo 0
        If Timer - t > MAXWAIT_sec Then
            Exit Do
        End If
    Loop While elems Is Nothing

    If Not elems Is Nothing Then
        elems.Item.Click
    End If



    IeDoc.getElementByID("checkConf").Click


    For Each aInput In IeDoc.getElementsbyTagName("input")
        If aInput.getAttribute("value") = "Request" Then
            aInput.Click
            Exit For
        End If
    Next aInput


    Do While IE.busy: DoEvents: Loop

    'Selects historical
    For Each aInput In IeDoc.getElementsbyTagName("input")
        If aInput.getAttribute("value") = "History" Then
            aInput.Click
            Exit For
        End If
    Next aInput


    lastrow = ws.Cells(ws.rows.Count, "A").End(xlUp).Row
    IE.Visible = True

    For i = 3 To lastrow

    Set IeDoc = IE.document ' set new page source

        Set svalue1 = IeDoc.getElementByID("Number")
        svalue1.Value = ws.Cells(i, 1).Value 'takes the  number out and enters
            'presses submit once numb is entered
            For Each aInput In IeDoc.getElementsbyTagName("input")
                If aInput.getAttribute("value") = "Submit" Then
                    aInput.Click
                    Exit For
                End If
            Next aInput

        IE.Navigate ("https://mywebsite.com/")
        Do While (IE.READYSTATE <> 4 Or IE.busy <> False): DoEvents: Loop
        IE.Visible = True
        Exit For


Next i
        Do While (IE.READYSTATE <> 4 Or IE.busy <> False): DoEvents: Loop
        IE.Visible = True


End Sub                

Answer 1

我尝试清理这个问题 - 尝试下面的代码。

你的问题很难回答，因为你的代码不仅难以理解，而且缩进很差，而且你的变量不明确。您还声明了似乎从未使用过的变量。

Option Explicit
Public Const UBlim As Long = 6
Sub Login()

    Dim IE As Object
    Dim eInput As Object
    Dim ws As Worksheet: Set ws = Sheets("VALUES")
    Dim i As Long
    Dim j As Long
    Dim lastrow As Long
    Dim svalue1 As Object
    Dim results As Variant
    Dim wkscnt As Long
    Dim wks As Excel.Worksheet
    Dim wkshtnames()
    Dim a As Object
    Dim b As Object
    Dim t As Date
    Dim elems As Object
    Const MAXWAIT_sec As Long = 10

    Set IE = CreateObject("InternetExplorer.application")
    IE.Visible = True
    IE.Navigate ("http://mywebsite.com/")

    With IE

        Do
            If IE.readystate = 4 Then
                Exit Do
            Else
                DoEvents
            End If
        Loop

        'Enters username and password

        With .document
            .forms("signingin").UserName.Value = "userr"
            .forms("signingin").Password.Value = "password"
            .forms("signingin").document.forms(0).submit

            'this clicks a button after logging in that says initiate new request
            t = Timer

            Do
                On Error Resume Next
                Set elems = .document.queryselectorall("input[value=Initiate]")
                On Error GoTo 0

                If Timer - t > MAXWAIT_sec Then
                    Exit Do
                End If

            Loop While elems Is Nothing

            If Not elems Is Nothing Then
                elems.Item.Click
            End If

            Application.Calculation = xlCalculationManual
            Application.CutCopyMode = False
            wkscnt = ThisWorkbook.Sheets.Count
            j = 0

            For Each wks In ActiveWorkbook.Worksheets

                j = j + 1

                If j > UBlim Then
                    ReDim Preserve wkshtnames(7 To wkscnt)
                    wkshtnames(j) = wks.Name
                End If

            Next wks

            If wkscnt > UBlim Then
                Application.DisplayAlerts = False
                Sheets(wkshtnames).Delete
                Application.DisplayAlerts = True
            End If

            lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

            For i = 3 To lastrow
                Set svalue1 = .getElementbyID("Number")
                svalue1.Value = ws.Cells(i, 1).Value
                i = i + 1

                For Each eInput In .getElementsbyTagName("input")
                    If eInput.getAttribute("value") = "Submit Request" Then
                        eInput.Click
                        Exit For
                    End If
                Next eInput

                IE.Visible = True

                'copy and pasting the info from the web page to a new excel sheet
                Sheets("Sheet4").Range("A1:Z100").ClearContents
                IE.ExecWB 17, 0 '//select
                IE.ExecWB 12, 2 '//Copy Selection
                ActiveSheet.Paste

                Sheets("Sheet4").Range("A3:Q32").Copy

                'Creates a new sheet after & pastes content into it, formats
                Sheets.Add After:=ActiveSheet
                ActiveSheet.Paste
                Selection.Columns.AutoFit
                Selection.Rows.AutoFit

                ActiveSheet.Protect
                'this navigates back to the page where I need to enter the value in the excel column again

                IE.Navigate ("https://mywebsite.com/Default")
            Next i

        End With

    End With

End Sub