VBA 获取网页多页数据 （网址不变）

本人五笔输入

大家好，我想获取一个网页的多页数据,数据量较大，手工极不方便，其链接如下：  http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/           (只是例子) ，现在我想实现把数据导入EXCEL中，如将上面链接中的3页数据导出，我参考论坛中的数据得到如下代码，其可以导入第一页数据，且可以实现翻页，但无法得到2.3页数据。我的理解是Document对象创立后没有更新，所以有问题。但不知如何处理，希望论坛朋友们帮我看看，谢谢。。。

代码如下：
   Sub a()
  Dim IEE As Object
  Dim mM As Integer
    mM = 0
    Set IEE = CreateObject("internetexplorer.application")
       IEE.Navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/"

    On Error Resume Next
    With IEE
        While .ReadyState <> 4 Or .Busy
            DoEvents
        Wend
        For mM = 1 To 3
        Set r = .Document.All.tags("table")(7).Rows
        For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(i + 1, j + 1) = r(i).Cells(j).innerText
                Cells(i + 1, 15) = mM                  ' 调试用
            Next j
        Next i
        .Document.All.tags("input")(6).Click
        Cells(mM, 1).Font.Color = vbRed             '调试用
       Next mM
    .Quit
    End With
    Cells.Font.Size = 9
    Cells.Columns.AutoFit
End Sub

获取网页数据.zip (18.92 KB, 下载次数: 121)

2014-8-17 22:56 上传

点击文件名下载附件

麻烦大家帮我看看吧，谢谢。。。。

本人五笔输入

没有人理我。。。。

此用户被禁言

你这个不是没有取到。是你在获取数据的时候，循环放在单元格时，你的变量不正确。。比如改成这样，你看效果，我只是大概看了一下，网页分析我不会。我想问一下，语句中这个表示网页什么元素？tags("table")(7).Rows   还有后面的7是什么意思

1. Sub a()
   
2.   Dim IEE As Object
   
3.   Dim mM As Integer
   
4.     mM = 0
   
5.     Set IEE = CreateObject("internetexplorer.application")
   
6.        IEE.Navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/"
   
7. 
   
8.     On Error Resume Next
   
9.     With IEE
   
10.         While .ReadyState <> 4 Or .Busy
    
11.             DoEvents
    
12.         Wend
    
13.         For mM = 1 To 3
    
14.         k = k + 1
    
15.         Stop
    
16.         Set r = .Document.All.tags("table")(7).Rows
    
17.         For i = 0 To r.Length - 1
    
18.             For j = 0 To r(i).Cells.Length - 1
    
19.                 Cells(k, j + 1) = r(i).Cells(j).innerText
    
20.                 'Cells(i + 1, 15) = mM                  ' 调试用
    
21.             Next j
    
22.             k = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
23.         Next i
    
24.         .Document.All.tags("input")(6).Click
    
25.         Cells(mM, 1).Font.Color = vbRed             '调试用
    
26.        Next mM
    
27.     .Quit
    
28.     End With
    
29.     Cells.Font.Size = 9
    
30.     Cells.Columns.AutoFit
    
31. End Sub
    

复制代码

本人五笔输入

此用户被禁言 发表于 2014-8-18 14:20
你这个不是没有取到。是你在获取数据的时候，循环放在单元格时，你的变量不正确。。比如改成这样，你看效果 ...

Sub a()
  Dim IEE As Object
  Dim mM As Integer
    mM = 0
    Set IEE = CreateObject("internetexplorer.application")
       IEE.Navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/"
   
    On Error Resume Next
    With IEE
        While .ReadyState <> 4 Or .Busy
            DoEvents
        Wend
        For mM = 1 To 9
           Set r = .Document.All.tags("table")(7).Rows
          For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(Range("a65536").End(xlUp).Row + 1, j + 1) = r(i).Cells(j).innerText
            Next j
         Next i
           Set r = Nothing
          .Document.All.tags("input")(6).Click
       Next mM
    .Quit
    End With
    Cells.Font.Size = 9
    Cells.Columns.AutoFit
End Sub

这是我现在写的代码，还在调试中，能够取到所有数据了，不过格式不对，我想可能是因为运行太快了，对于那个7，因为返回的是一个数组对象，我想取其第8个，这是文档解析内容，你可以了解一下。。。

本人五笔输入

完整的代码如下:
Sub a()
  Dim IEE As Object
  Dim mM As Integer
  Dim Kkk As Integer
    mM = 0
    Set IEE = CreateObject("internetexplorer.application")
       IEE.Navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjmx/index.shtml?CATALOGID=1906_ipoxjgk&TABKEY=tab1&txtJCorDH=300373&zqjc=扬杰科技&fxrq=2014-01-15"
  
   
    On Error Resume Next
    With IEE
        While .ReadyState <> 4 Or .Busy
            DoEvents
        Wend
        For mM = 1 To 19
           Set r = .Document.All.tags("table")(7).Rows
          For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(Range("a65536").End(xlUp).Row + 1, j + 1) = r(i).Cells(j).innerText
            Next j
         Next i
           Set r = Nothing
          .Document.All.tags("input")(6).Click
         
          Application.Wait (Now + TimeValue("0:00:03"))
       Next mM
    .Quit
    End With
    Cells.Font.Size = 9
    Cells.Columns.AutoFit
End Sub

suwenkai

1. Sub 按钮1_Click()
   
2.     Dim url, html
   
3.     For p = 1 To 19
   
4.         url = "http://eipo.szse.cn/szseWeb/FrontController.szse?"
   
5.         url = url & "ACTIONID=7&AJAX=AJAX-TRUE&CATALOGID=1906_ipoxjgk&"
   
6.         url = url & "txtJCorDH=300373&TABKEY=tab1&tab2PAGENUM=" & p
   
7.         url = url & "&tab2PAGECOUNT=19&tab2RECORDCOUNT=371"
   
8.         Set html = CreateObject("htmlfile")
   
9.         With CreateObject("msxml2.xmlhttp")
   
10.             .Open "GET", url, False
    
11.             .send
    
12.             html.body.innerhtml = .responsetext
    
13.             Set tb = html.all.tags("table")(12).Rows
    
14.             If p = 1 Then
    
15.                 m = 0
    
16.             Else
    
17.                 m = 1
    
18.             End If
    
19.             For i = m To tb.Length - 1
    
20.                 n = n + 1
    
21.                 For j = 0 To tb(i).Cells.Length - 1
    
22.                     Cells(n, j + 1) = tb(i).Cells(j).innertext
    
23.                 Next
    
24.             Next
    
25.         End With
    
26.     Next
    
27. End Sub
    
28. Sub 按钮2_Click()
    
29.     Cells.ClearContents
    
30. End Sub
    

复制代码

VBA万岁

Sub a()
Dim IEE As Object
  Dim mM As Integer
    mM = 0
    Set IEE = CreateObject("internetexplorer.application")
       IEE.Navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/"

    On Error Resume Next
    With IEE
        While .ReadyState <> 4 Or .Busy
            DoEvents
        Wend
        For mM = 1 To 3
        Set r = .Document.All.tags("table")(7).Rows
        For i = 0 To r.Length - 1
            n = n + 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(n, j + 1) = r(i).Cells(j).innerText
                Cells(n, 15) = mM                  ' 调试用
            Next j
        Next i
        .Document.All.tags("input")(6).Click
        Cells(n + 1, 1).Font.Color = vbRed         '调试用
       Next mM
    .Quit
    End With
    Cells.Font.Size = 9
    Cells.Columns.AutoFit
End Sub

本人五笔输入

suwenkai 发表于 2014-8-18 17:15

谢谢，您完美的解决了我的问题，谢谢无私的帮助。。。

VBA万岁

本人五笔输入 发表于 2014-8-18 15:31
Sub a()
  Dim IEE As Object
  Dim mM As Integer

我没有安装“按键精灵”，无法精确获知table，input标签的“索引”值（分别为7、6），故只能用以下笨办法获取：
    ......
    For i = 0 To .Document.all.Length - 1
        If UCase(.Document.all(i).tagname) = "TABLE" Then
            t = t + 1
            If .Document.all(i).Rows(0).Cells(0).innertext = "发行日" Then Exit For
        End If
    Next
        
    For i = 0 To .Document.all.Length - 1
        If UCase(.Document.all(i).tagname) = "INPUT" Then
            a = a + 1
            If .Document.all(i).innertext = "下一页" Then Exit For
        End If
    Next
    ......

VBA万岁

VBA万岁 发表于 2014-8-19 20:19
我没有安装“按键精灵”，无法精确获知table，input标签的“索引”值（分别为7、6），故只能用以下笨办法 ...

完整代码如下：

Sub 多网页数据批量提取()
Dim ti, r As Object
Dim mM%, t%, a%, i%, j%
On Error Resume Next
mM = 0
ti = Timer
With CreateObject("internetexplorer.application")
    .navigate "http://eipo.szse.cn/main/eipo/xjxx/fxrxjxx/"
    Do While .Busy Or ti + 2 > Timer
        DoEvents
    Loop
        
    For i = 0 To .Document.all.Length - 1
        If UCase(.Document.all(i).tagname) = "TABLE" Then
            t = t + 1
            If .Document.all(i).Rows(0).Cells(0).innertext = "发行日" Then Exit For
        End If
    Next
        
    For i = 0 To .Document.all.Length - 1
        If UCase(.Document.all(i).tagname) = "INPUT" Then
            a = a + 1
            If .Document.all(i).innertext = "下一页" Then Exit For
        End If
    Next
   
    For mM = 1 To 3
        Set r = .Document.all.tags("table")(t - 1).Rows
        For i = 0 To r.Length - 1
            n = n + 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(n, j + 1) = r(i).Cells(j).innertext
                Cells(n, 15) = mM
            Next j
        Next i
        Set r = Nothing
        .Document.all.tags("input")(a - 1).Click
        Cells(n + 1, 1).Font.Color = vbRed
        ti = Timer
        Do While .Busy Or ti + 2 > Timer
            DoEvents
        Loop
    Next mM
    .Quit
End With
Cells.Font.Size = 9
Cells.Columns.AutoFit
End Sub