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

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"

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
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.