Perlu menarik data dari situs web setelah setiap 5 detik menggunakan Vba [ditutup]

1

Saya perlu menarik data dari www.dsebd.org setelah 5 detik. kode VBA ini menarik data tetapi tidak berjalan secara otomatis. Tolong bantu aku.

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
Milton
sumber
Apakah Anda mendapatkan kesalahan?
Dave
Iya. ThisWorkbook.Sheets ("Sheet1"). Sel (ActRw + r + 1, c +1) = elemcollection (t) .Rows (r) .Cell (c) .innerText Baris ini salah.
Milton
Apa kesalahannya
Dave
INI DI GARIS INI. KETIKA SAYA MENJALANKAN MAKRO, KESALAHAN MENURUT MENUNJUKKAN DALAM GARIS INI DENGAN WARNA KUNING. TOLONG BANTU AKU. SAYA PERLU MEMBUTUHKAN. ThisWorkbook.Sheets ("Sheet1"). Sel (ActRw + r + 1, c + 1) = elemcollection (t) .Rows (r) .Cell (c) .innerText
Milton
Menulis dalam huruf kapital tidak akan membantu Anda. Anda sepertinya masih tidak mengerti saya. Apa pesan kesalahannya? Apakah itu mengatakan "Kode kesalahan 0111015" atau apakah itu mengatakan "Masalah debug"? Apakah ada pesan kesalahan? Saya menjalankan kode Anda tanpa masalah.
Dave

Jawaban:

0

Anda tidak menyatakan apa pesan kesalahan itu, atau di mana pesan itu muncul. Saya menduga tidak dapat menemukan kode yang dimaksud. Jadi, ubah

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

untuk

Application.OnTime Now + TimeValue("00:00:05"), "thisworkbook.ButtonCode"
Dave
sumber
Terimakasih Dave. Bahkan setelah koreksi yang diusulkan saya memiliki masalah debug yang sama. Masalahnya ada di "ThisWorkbook.Sheets (" Sheet1 "). Cells (ActRw + r + 1, c +1) = elemcollection (t) .Rows (r) .Cell (c) .innerText"
Milton