我在使用不同的网址获取数据时,我的宏取得了很好的进展。使用下面的代码块我得到的错误就像" 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 = ""
这一行的目的是,如果页面返回空,继续从链接获取数据。我有什么错误可以帮助我吗?这是我的宏工作的最后一部分。提前致谢。
答案 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