[ 2012 @ 14.09.2015. 07:33 ] @
Imam jedan macro za kopiranje podataka sa web sajta www.xscores.com, pokupio sam ga pre vise godina, radio je kako treba, prestao sam da ga koristim pre dve-tri godine i to je bilo snimljeno na nekom HDD. Juce sam trazeci nesto slicno i naleteo na ovaj macro, ali sad nece da radi. Evo vec nekoliko sati se zafrkavam ali nikako da povucem podatke. Da li bi neko imao ideju gde moze biti problem? 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.xscores.com/LiveSco...amp;newState=promptSoccerTable " '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 15 mins s = Now Do Until Now >= s + TimeValue("00:15:00") DoEvents Loop GoTo 1 End Sub Macro sam preuzeo sa ove lokacije: http://www.mrexcel.com/forum/e...7-copy-webdata-into-excel.html |