Question

此代码正在访问URL并将其下载到Excel工作表。它工作正常一段时间（虽然存在一些格式化问题）但是在将一个文件下载到工作表之后突然停止了。它出现以下运行时错误：

运行时错误2147467259 80004005 自动错误未指明的错误

 Option Explicit

 Sub first()



Dim HTMLDoc As New HTMLDocument
Dim objTable As Object, objElementTR, objTR
Dim lRow   As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw  As Long
Dim objIE  As InternetExplorer
Set objIE = New InternetExplorer
Dim i As Integer
Dim myurl As String

i = 1
 Do While i < 310
  objIE.Navigate " http://www.racingpost.com/greyhounds     /dog_home.sd?dog_id=" & i & ""

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
    DoEvents
    Loop

Application.Wait (Now + TimeValue("0:00:03"))
HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
With HTMLDoc.body

    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = .getElementsByTagName("H1")(0).innerText
    Set objElementTR = .getElementsByTagName("li")
    ActRw = ActRw + 1
    For Each objTR In objElementTR

        ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTR.innerText
        ActRw = ActRw + 1
    Next
    Set objTable = .getElementsByTagName("Table")
    For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End With
objIE.Quit
i = i + 1
Loop

End Sub

任何人都可以帮忙吗

亲切的问候科林

Answer 1

删除网址中的额外空格

 http://www.racingpost.com/greyhounds/dog_home.sd?dog_id=

它可以帮助您解决问题。

vba URL访问中的运行时错误

1 个答案: