| metalacos |
17.07.2014. 18:15 |
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
|
