1

Мне нужно вытащить данные с www.dsebd.org через 5 секунд. этот код VBA извлекает данные, но не запускается автоматически. Пожалуйста, помогите мне.

Sub ButtonCode()

     ' execute macros
    Call GetCotton
     ' submit macro to run again in 5 sec
    Application.OnTime Now + TimeValue("00:00:05"), "ButtonCode"

End Sub

Sub GetCotton()

        Dim xml    As Object
    Dim html   As Object
    Dim elemcollection As Object
    Dim result As String
    Dim t As Long, r As Long, c As Long, ActRw As Long
    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
    With xml
        .Open "GET", "http://www.dsebd.org/dseX_share.php", False
        .send
    End With
    result = xml.responseText
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = result
    Set elemcollection = html.getElementsByTagName("table")
    For t = 0 To elemcollection.Length - 1
        For r = 0 To elemcollection(t).Rows.Length - 1
            For c = 0 To elemcollection(t).Rows(r).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + r + 1, c + 1) = elemcollection(t).Rows(r).Cells(c).innerText
            Next c
        Next r
        ActRw = ActRw + elemcollection(t).Rows.Length + 1
    Next t
End Sub

1 ответ1

0

Вы не указываете, что это за сообщение об ошибке или где оно происходит. Я подозреваю, что это не может найти рассматриваемый код. Итак, измени

Application.OnTime Now + TimeValue("00:00:05"), "ButtonCode"

в

Application.OnTime Now + TimeValue("00:00:05"), "thisworkbook.ButtonCode"

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .