Question

目前我有2段代码可以单独使用，但是当它们一起使用时，它们无法正常工作。

第一个代码要求用户输入存储的信息。然后导航到正确的网页，在该网页中，它使用存储的用户输入信息通过填写和提交表单进行导航。它到达正确的地方。

第二个代码通过ie.navigate "insert url here"使用特定网址导航到与第一个代码相同的位置。然后它会擦除URL数据并将其存储在新创建的工作表中。它正确地做到了。

合并它们时，我用第一个代码替换第二个代码中的导航段，但是它只存储60个URL中的前5个，就像它在抓取数据之前没有完全加载页面一样。它似乎在ie.document.forms(0).submit之后直接跳过代码，它应该等待页面加载，然后继续进行抓取..

额外信息：按钮未定义，所以我不能单击它，所以我不得不使用ie.document.forms(0).submit

我希望代码执行的摘要：

 request user input
    store user input
    open ie
    navigate to page
    enter user input into search field
    select correct search category from listbox
    submit form
  'problem happens here
    scrape url data
    store url data in specific excel worksheet

合并代码：

    Sub extractTablesData()

                 Dim ie As Object, obj As Object
                 Dim Var_input As String
                 Dim elemCollection As Object
                 Dim html As HTMLDocument
                 Dim Link As Object
                 Dim erow As Long


                ' create new sheet to store info
                Application.DisplayAlerts = False
                ThisWorkbook.Sheets("HL").Delete
                ThisWorkbook.Sheets.Add.Name = "HL"
                Application.DisplayAlerts = True

                 Set ie = CreateObject("InternetExplorer.Application")

                 Var_input = InputBox("Enter info")

                 With ie

                 .Visible = True
                 .navigate ("URL to the webpage")

                 While ie.readyState <> 4
                 DoEvents
                 Wend

                'Input Term 1 into input box
                ie.document.getElementById("trm1").Value = Var_input


                'accessing the Field 1 ListBox
                For Each obj In ie.document.all.Item("FIELD1").Options

                        If obj.Value = "value in listbox" Then

                            obj.Selected = True

                        End If

                    Next obj

                ' button undefined - using this to submit form
                ie.document.forms(0).submit
'----------------------------------------------------------------                 
        'seems to skip this part all together when merged           

        'Wait until IE is done loading page
        Do While ie.readyState <> READYSTATE_COMPLETE

        Application.StatusBar = "Trying to go to website…"
        DoEvents
        Loop

'----------------------------------------------------------------        
        Set html = ie.document
        Set ElementCol = html.getElementsByTagName("a")

        For Each Link In ElementCol
        erow = Worksheets("HL").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Cells(erow, 1).Value = Link
        Cells(erow, 1).Columns.AutoFit
        Next


        Application.StatusBar = “”
        Application.ScreenUpdating = True

               End With
            End Sub

我已经坚持了很长一段时间并且没有找到任何解决方案，所以我伸出援手。任何帮助将不胜感激！

Answer 1

您提到您认为该网站可能未完全加载。这是一个常见问题，因为网页上的动态元素更多。处理此问题的最简单方法是插入以下行：

Application.Wait Now + Timevalue("00:00:02")

这将强制代码暂停2秒钟。在等待加载页面的代码下面插入此行，这将使Internet Explorer有机会进行备份。根据网站和连接的可靠性，我建议在任何地方调整此值最多约5秒。

大多数网站似乎都需要额外的等待，所以方便的代码可以在事情无法正常工作时记住。希望这会有所帮助。

Answer 2

我通过使用完全不同的方法解决了这个问题。我使用带有字符串的查询表去了我想要的地方。

 Sub ExtractTableData()
    Dim This_input As String
    Const prefix As String = "Beginning of url"
    Const postfix As String = "end of url"

    Dim qt As QueryTable
    Dim ws As Worksheet

    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("HL").Delete
    ThisWorkbook.Sheets.Add.Name = "HL"
    Application.DisplayAlerts = True


    This_input = InputBox("enter key info to go to specific url")
    Set ws = ActiveSheet

    Set qt = ws.QueryTables.Add( _
    Connection:="URL;" & prefix & This_input & postfix, _
    Destination:=Worksheets("HL").Range("A1"))

    qt.RefreshOnFileOpen = True
    qt.WebSelectionType = xlSpecifiedTables
'qt.webtables is key to getting the specific table on the page     
    qt.WebTables = 2

    qt.Refresh BackgroundQuery:=False



    End Sub

VBA在IE中提交表单后直接跳过代码

2 个答案: