请问如何从网页上抓取数据 QueryTables不能用！

lalasnoopy

http://www.hsi.com.hk/HSI-Net/HSI-Net 在网页第一栏 news room里面， 有一个Index / other notices，点进去以后，希望类似下面的信息全部抓取到excel里面，然后每天可以自动执行，请问这个VBA怎么写呢？？ 已经尝试过excel自带的import data from web功能了，但是出来的全部都是loading.... 求牛人帮忙！！感谢！

28 May 2012	Constituent Changes in Hang Seng Family of Indexes
23 May 2012	Constituent Changes in Hang Seng Family of Indexes
10 May 2012	Index Review Results of Thematic Indexes (Hong Kong Market)
2 May 2012	Constituent Changes in Hang Seng Family of Indexes
18 April 2012	Constituent Changes in Hang Seng Family of Indexes
23 February 2012	Constituent Changes in Hang Seng Family of Indexes
10 February 2012	Index Review Results of Benchmark Indexes
10 February 2012	Index Review Results of Thematic Indexes
9 January 2012	Constituent Changes in Hang Seng Family of Indexes
3 January 2012	Constituent Changes in Hang Seng Family of Indexes

kangatang

你要PDF吗？链接是pdf文件

lalasnoopy

kangatang 发表于 2012-6-25 10:24
你要PDF吗？链接是pdf文件

不需要PDF~ 只要表里面的那些信息就可以了~~ 谢谢！！

蓝天630902

Sub Hang_Seng_Indexes()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://www.hsi.com.hk/HSI-Net/HSI-Net"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        .Document.All.tags("a")(69).Click
        Do Until .Document.All.tags("input")(1).Value = "en.news.index_change"
            DoEvents
        Loop
        k = 0
        p = 0
        n = Range("a65536").End(xlUp).Row
        Set r = .Document.All.tags("td")
        For i = 0 To r.Length
            n = Range("a65536").End(xlUp).Row
            If Left(r(i).innerText, 12) = "Useful Links" Then Exit For
            If k = 1 Then
                p = p + 1
                s = p Mod 2
                Cells(1 + n, s + 1) = r(i).innerText
            End If
            If Trim(r(i).innerText) = "Title" Then k = 1
        Next i
        .Quit
    End With
End Sub

lalasnoopy

先谢过再看 太牛了！！

lalasnoopy

请问 .Document.All.tags("a")(69).Click 还有 .Document.All.tags("td") 是什么意思呀？ 网上也查不到解释，excel自带的帮助也没有解释的...

这个是一种神马语言呐....
感觉操作都隐藏在internet explorer里面的样子，vba到底每一步发生了什么我没法看到...
OH 好难...

蓝天630902

lalasnoopy 发表于 2012-6-25 13:48
请问 .Document.All.tags("a")(69).Click 还有 .Document.All.tags("td") 是什么意思呀？ 网上也查不到解释 ...

Sub Hang_Seng_Indexes()
    On Error Resume Next '
    With CreateObject("internetexplorer.application") '创建一个空的ie
        .Visible = True 'ie可见
        .Navigate "http://www.hsi.com.hk/HSI-Net/HSI-Net" '导航到http://www.hsi.com.hk/HSI-Net/HSI-Net
        Do Until .ReadyState = 4 '直到ie加载完毕
            DoEvents
        Loop
        .Document.All.tags("a")(69).Click '点击第69个“ａ”标签，这里“ａ”是网页标签
        t1 = Timer
        Do Until Timer > t1 + 2 '等待2秒钟
            DoEvents
        Loop
        Do Until .ReadyState = 4 '直到新ie加载完毕
            DoEvents
        Loop
        k = 0
        p = 0
        n = Range("a65536").End(xlUp).Row '第a列最后行号
            Set r = .Document.All.tags("td") '指定ｒ为“ｔｄ”标签，这里“ｔｄ”也是网页标签
            For i = 0 To r.Length 'ｒ的长度，也就是ｒ的个数
                n = Range("a65536").End(xlUp).Row '第a列最后行号
                If Left(r(i).innerText, 12) = "Useful Links" Then Exit For '如果，第ｉ个ｒ（也就是第ｉ个ｔｄ）的内容的左边的12个字符是“Useful Links”，就跳出循环。
                If k = 1 Then
                p = p + 1
                s = p Mod 2
                Cells(1 + n, s + 1) = r(i).innerText '把第ｉ个ｒ（也就是第ｉ个ｔｄ）的内容写入Cells(1 + n, s + 1)单元格
                End If '
                If Trim(r(i).innerText) = "Title" Then k = 1 '如果，第ｉ个ｒ（也就是第ｉ个ｔｄ）的内容是“Title”，就把1赋给ｋ。
            Next i
    End With
End Sub

bluexuemei

蓝天630902 发表于 2012-6-25 20:35
Sub Hang_Seng_Indexes()
    On Error Resume Next '
    With CreateObject("internetexplorer.appli ...

69是怎么来的?

蓝天630902

bluexuemei 发表于 2012-6-25 21:38
69是怎么来的?

Sub 查找a标签()
    On Error Resume Next
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://www.hsi.com.hk/HSI-Net/HSI-Net"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set r = .Document.All.tags("a") '“ａ”标签
        For i = 0 To r.Length - 1       '标签的个数
            Cells(i + 1, 1) = i
            Cells(i + 1, 2) = r(i).innerText '把第ｉ个标签的内容写入第ｉ+1行，2 列
        Next i
    End With
End Sub

蓝天630902

69	Index / Other Notices