edneco
12-13-2013, 11:44 AM
Hello again..... I need to extract 3 tables from web, but I canīt do it.... Iīm using a VBA code to import some tables from web, by recording macros... This is the only way that I can "write" some code....
This is it: w w w.stat-football.c o m/en/t/eng10.php?c=25&ht=h1
As you can see, the table is "1st half total goals 1.5", Home and Away. But I need the "1st half total goals 0.5" table, Home and Away.
But the problem is the 3 tables that I want to import, needed to be selected by choose them and clicking in a submit button. But with a macro, this steps wonīt appear in the code....
Then I ask for help, I this guy that help me, made a code to me, but donīt work..... Can you guys help me with this???
Public HTMLdoc As Object
Public PageSrc As String
Function GetText(ByRef objHTML As Object, ByRef TextOut As String)
Dim flag As Boolean
Dim i As Long
' Returns the text from HTML elements using recursion.
If objHTML.HasChildNodes = True Then
For i = 0 To objHTML.ChildNodes.Length - 1
With objHTML.ChildNodes(i)
If UCase(.nodeName) = "BR" Then flag = True
Select Case .NodeType
Case 1 'Element
DoEvents
' Check if element contains any nodes with text.
If .HasChildNodes Then
Call GetText(objHTML.ChildNodes(i), TextOut)
End If
Case 3 'Text
If .NodeValue <> "" Then
If flag = True Then TextOut = TextOut & vbLf
TextOut = TextOut & .NodeValue
End If
End Select
End With
flag = False
Next i
End If
' Return a text string of the elements' text separated by a pipe character | .
GetText = TextOut
End Function
Sub OpenWebPage(ByVal URL As String)
PageSrc = ""
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, True
.Send
While .readyState <> 4: DoEvents: Wend
' Check for any connection errors.
If .statusText <> "OK" Then
MsgBox "ERROR: " & .Status & " - " & .statusText, vbExclamation
Exit Sub
End If
PageSrc = .ResponseText
End With
' Create an empty HTML Document and load it with the Page Source.
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.body.innerHTML = PageSrc
End Sub
Sub ListGameData()
Dim oButton As Object
Dim oDiv As Object
Dim oHeader As Object
Dim oItem As Object
Dim oRow As Object
Dim oSelect As Object
Dim oTable As Object
Dim Rng As Range
Dim Text As String
Dim Wks As Worksheet
Set Wks = Folha2
Set Rng = Wks.Range("E5:Q25, S5:AE25, AG5:AS25")
OpenWebPage "w w w.stat-football. c om /en/t/eng10.php?c=25&ht=h1"
For Each oItem In HTMLdoc.getElementsByTagNAme("select")
If oItem.Name = "tot" Then
Set oSelect = oItem
Exit For
End If
Next oItem
For Each oItem In HTMLdoc.getElementsByTagNAme("input")
If oItem.Type = "submit" And oItem.Value = " >> " Then
Set oButton = oItem
Exit For
End If
Next oItem
Set oDiv = HTMLdoc.getElementById("y0")
Set oHeader = oDiv.ChildNodes(0)
Set oTable = HTMLdoc.getElementById("tb01")
For n = 1 To 3
oSelect.selectedIndex = n - 1
oButton.Click ' <--- This causes an error
For r = 0 To oTable.Rows.Length - 1
For c = 0 To oTable.Rows(r).Cells.Length - 1
Text = ""
Rng.Areas(n).Item(r + 1, c + 1) = GetText(oTable.Rows(r).Cells(c), Text)
Next c
Next r
Rng.Areas(n).Columns.AutoFit
Next n
End Sub
I thank you, in advance, if you help me with this.....
Best regards, Eduardo
This is it: w w w.stat-football.c o m/en/t/eng10.php?c=25&ht=h1
As you can see, the table is "1st half total goals 1.5", Home and Away. But I need the "1st half total goals 0.5" table, Home and Away.
But the problem is the 3 tables that I want to import, needed to be selected by choose them and clicking in a submit button. But with a macro, this steps wonīt appear in the code....
Then I ask for help, I this guy that help me, made a code to me, but donīt work..... Can you guys help me with this???
Public HTMLdoc As Object
Public PageSrc As String
Function GetText(ByRef objHTML As Object, ByRef TextOut As String)
Dim flag As Boolean
Dim i As Long
' Returns the text from HTML elements using recursion.
If objHTML.HasChildNodes = True Then
For i = 0 To objHTML.ChildNodes.Length - 1
With objHTML.ChildNodes(i)
If UCase(.nodeName) = "BR" Then flag = True
Select Case .NodeType
Case 1 'Element
DoEvents
' Check if element contains any nodes with text.
If .HasChildNodes Then
Call GetText(objHTML.ChildNodes(i), TextOut)
End If
Case 3 'Text
If .NodeValue <> "" Then
If flag = True Then TextOut = TextOut & vbLf
TextOut = TextOut & .NodeValue
End If
End Select
End With
flag = False
Next i
End If
' Return a text string of the elements' text separated by a pipe character | .
GetText = TextOut
End Function
Sub OpenWebPage(ByVal URL As String)
PageSrc = ""
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, True
.Send
While .readyState <> 4: DoEvents: Wend
' Check for any connection errors.
If .statusText <> "OK" Then
MsgBox "ERROR: " & .Status & " - " & .statusText, vbExclamation
Exit Sub
End If
PageSrc = .ResponseText
End With
' Create an empty HTML Document and load it with the Page Source.
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.body.innerHTML = PageSrc
End Sub
Sub ListGameData()
Dim oButton As Object
Dim oDiv As Object
Dim oHeader As Object
Dim oItem As Object
Dim oRow As Object
Dim oSelect As Object
Dim oTable As Object
Dim Rng As Range
Dim Text As String
Dim Wks As Worksheet
Set Wks = Folha2
Set Rng = Wks.Range("E5:Q25, S5:AE25, AG5:AS25")
OpenWebPage "w w w.stat-football. c om /en/t/eng10.php?c=25&ht=h1"
For Each oItem In HTMLdoc.getElementsByTagNAme("select")
If oItem.Name = "tot" Then
Set oSelect = oItem
Exit For
End If
Next oItem
For Each oItem In HTMLdoc.getElementsByTagNAme("input")
If oItem.Type = "submit" And oItem.Value = " >> " Then
Set oButton = oItem
Exit For
End If
Next oItem
Set oDiv = HTMLdoc.getElementById("y0")
Set oHeader = oDiv.ChildNodes(0)
Set oTable = HTMLdoc.getElementById("tb01")
For n = 1 To 3
oSelect.selectedIndex = n - 1
oButton.Click ' <--- This causes an error
For r = 0 To oTable.Rows.Length - 1
For c = 0 To oTable.Rows(r).Cells.Length - 1
Text = ""
Rng.Areas(n).Item(r + 1, c + 1) = GetText(oTable.Rows(r).Cells(c), Text)
Next c
Next r
Rng.Areas(n).Columns.AutoFit
Next n
End Sub
I thank you, in advance, if you help me with this.....
Best regards, Eduardo