Option Explicit
Public Sub tableTest()
Dim txt, web
Set web = CreateObject("MSXML2.XMLHTTP")
web.Open "Get", "http://nba.sports.sina.com.cn/match_result.php?dpc=1", False
web.send
txt = StrConv(web.responseBody, vbUnicode, &H804)
txt = "
PutClipboard txt
Cells.Clear
[A1].Select
ActiveSheet.Paste
txt = StrConv(web.responseBody, vbUnicode, &H804)
txt = HtmlFilter(txt, "", "")
PutClipboard txt
Range("A" & ActiveSheet.UsedRange.Rows.Count + 2).Select
ActiveSheet.Paste
End Sub
Public Sub tableTest2()
Dim txt, web
Set web = CreateObject("MSXML2.XMLHTTP")
web.Open "Get", "http://nba.sports.sina.com.cn/league_order1.php?dpc=1", False
web.send
txt = StrConv(web.responseBody, vbUnicode, &H804)
txt = "
")PutClipboard txt
Cells.Clear
[A1].Select
ActiveSheet.Paste
txt = StrConv(web.responseBody, vbUnicode, &H804)
txt = HtmlFilter(txt, "", "")
PutClipboard txt
[A39].Select
ActiveSheet.Paste
End Sub
Public Function HtmlFilter(ByVal htmlText$, Label1$, label2$)
'返回html字符串lable1和最近的lable2标签中的数据
Dim pStart As Long, pStop As Long
'开始位置,结束位置
pStart = InStr(htmlText, Label1) + Len(Label1)
'找到标签信息的起始位置
If pStart <> 0 Then
pStop = InStr(pStart, htmlText, label2)
HtmlFilter = Mid(htmlText, pStart, pStop - pStart)
End If
End Function
Public Sub PutClipboard(ByVal tt$) 'tt放入剪贴板
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '调试用,数据放入剪贴板
.SetText tt
.PutInClipboard
End With
End Sub