|
![]() |
#1 |
Premium
Datum registracije: Dec 2006
Lokacija: Osijek
Postovi: 69
|
Excel VBA pomoc
Nasao sam na netu kod koji povlaci livescore sa web stranice navedene u kodu. Naime kod povlači samo nekoliko parova i neće povući sve utakmice sa live-a. Kad pokrenem kod otvori mi se stranica na netu, kliknem na live i on ocitava no ne ocitava sve trenutne utakmice. Treba mi pomoc da mi ocita sve utakmice iz Live-a. Hvala na svakoj pomoci. Code:
Sub xScoresTable_Import() Dim ie As InternetExplorer Dim i As Range Dim x As Range Dim y As Range Dim BinString As String Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True 'Go to this Web Page! ie.navigate "http://www.livescore.in/tennis/ " 'Check for good connection to web page loop! Do Until ie.readyState = READYSTATE_COMPLETE DoEvents Loop Do Until ie.Busy = False DoEvents Loop ' type STOP in cell A1 to stop the macro/refresh 1 If Range("A1").Value = "STOP" Then Exit Sub Cells.Select Selection.Clear '.Delete Range("A1").Select Dim oResultPage As HTMLDocument Dim AllTables As IHTMLElementCollection Dim xTable As HTMLTable Dim TblRow As HTMLTableRow Dim myWkbk As Worksheet 'copy "data" table Set oResultPage = ie.Document Set AllTables = oResultPage.getElementsByTagName("table") Set xTable = AllTables.Item(2) Set myWkbk = ActiveWorkbook.Sheets("Sheet2") For Each TblRow In xTable.Rows r = r + 1 For Each tblCell In TblRow.Cells c = c + 1 myWkbk.Cells(r, c) = tblCell.innerText Next tblCell c = 0 Next TblRow r = 0 ' refresh values every 1 sec s = Now Do Until Now >= s + TimeValue("00:00:01") DoEvents Loop GoTo 1 End Sub |
![]() |
![]() |
|
|
Oglas
|
Oglasni prostor
|
![]() |
Uređivanje | |
|
|