未定义的对象定义问题

时间:2018-03-01 17:56:24

标签: excel vba excel-vba

我在使用不同的网址获取数据时,我的宏取得了很好的进展。使用下面的代码块我得到的错误就像" Undefined Object":

Sub GetData()
    Dim IE As Object, doc As Object
    Dim strURL As String, myDate As Date

    Set IE = CreateObject("InternetExplorer.Application")
    With IE

        For myDate = CDate("01-05-2017") To CDate("05-05-2017")

            strURL = "https://www.ukdogracing.net/racecards/" & Format(myDate, "dd-mm-yyyy") & "/monmore" ' Trim(Str(I))
            .navigate strURL
            Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
            Set doc = IE.Document
            GetAllTables doc

        Next myDate

        .Quit
    End With
End Sub


 Sub GetAllTables(doc As Object)

    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim I As Long
    Dim ThisLink As Object 'variable for <a> tags
    Set ws = Worksheets.Add

    For Each tbl In doc.getElementsByTagName("TABLE")
        tabno = tabno + 1
        nextrow = nextrow + 1
        Set rng = ws.Range("B" & nextrow)

        rng.Offset(, -1) = "Table " & tabno
        For Each rw In tbl.Rows
            For Each cl In rw.Cells
                rng.Value = cl.outerText
                Set rng = rng.Offset(, 1)
                myDate = myDate + 1
            Next cl
        nextrow = nextrow + 1
        Set rng = rng.Offset(1, -myDate)
        myDate = 0
        Next rw
    Next tbl

    myDate = Range("B" & Rows.Count).End(xlUp).Row 'last row with data

    Do While Cells(myDate, 1).Value = "" 'will loop until first not blank found in column A (starting from last row of data, from end to start)
        For Each ThisLink In doc.getElementsByTagName("a") 'we check all <a> tags
            If ThisLink.innerText = Cells(myDate, 2).Value Then Cells(myDate, 1).Value = ThisLink.href 'If the innertext is the name of the race, in column A we add link
        Next ThisLink
        myDate = myDate - 1 'we decrease row position
    Loop
    End Sub

问题在于:

 Do While Cells(myDate, 1).Value = ""

这一行的目的是,如果页面返回空,继续从链接获取数据。我有什么错误可以帮助我吗?这是我的宏工作的最后一部分。提前致谢。

1 个答案:

答案 0 :(得分:1)

我认为您遇到的错误可能与myDate的值有关。它不能为零。

如果我这样做:

Option Explicit

Sub TEST()

Dim myDate As Date

myDate = 1

Do While Cells(myDate, 1).Value = "" 

    myDate = myDate - 1

Loop

End Sub

我得到了Object定义的错误。我避免这个:

Option Explicit

Sub TEST()

Dim myDate As Date

myDate = 1

Do While Cells(myDate, 1).Value = "" 

    myDate = myDate - 1
    If Int(myDate) = 0 Then Exit Do 

Loop
End Sub