从网页上精确提取数据

第一部分  从网页上精确提取数据
    本部分的实例是：下载沪深两市全部约1100家个股的基本信息及财务数据。若用手工操作，如上图所示，需要在股票代码区内分别输入1100个股票代码，在下拉式列表（ComboBox）中分别选择“个股资料”和“财务数据解读”，算下来约是2200次操作！这样的工作当然是由程序来完成划算得多。况且手工提取数据（先选中、再使用Ctrl+C拷贝）极容易出错（多选或漏选），又很费眼神。
1. 在输入区内自动填入数据
    为使程序能高效地自动浏览，需引入一些最基本的功能，如在输入区内自动填入数据、自动点击按钮等等。虽然用变换 URL地址的方法有时也能完成任务，但往往过于费力，尤其当网页上的输入区较多时更是如此。
    为了在输入区内输入数据，需要先搜索到该对象的名字，然后将该对象的值置为要填入的数据即可。搜索名字的工作可编程完成，亦可用 FrontPage轻松获得。
2. 自动在下拉式列表（ComboBox）中进行选择
    同样地，首先要获得下拉式列表的名字。然后根据下拉式列表的元素总数（length属性）在列表中搜索要设置的值（列表的 Options集合中元素的Text属性），找到后，将该元素设为选中元素（元素的Selected属性）。
3. 自动点击按钮
    对于按钮来讲，可根据其名字访问，亦可根据其值访问。按钮的值就是显示在按钮上的文字。一个按钮可能没有名字，但一定有值。本例的程序就是根据值来访问按钮。执行按钮的 Click方法就相当于点击了该按钮。
    图二中红色箭头所指即为程序自动填入输入框、自动在ComboBox中选择以及自动点击按钮的情况。
4. 精确提取数据
    仅将有用的数据存储下来才是有意义的。必须研究网页，找出有效数据所在的Tag区（可用文本编辑器或 FrontPage），然后用该对象的innerText属性获得最终的文本。本例中要存储的数据如下图所示，其所用的Tag为“PRE”。
    下面给出的是实例程序的完整代码：
' 程序一：从网页上精确提取数据
'' 为运行本程序，应在“菜单->工程->部件”中添加“Microsoft Internet Controls”
' 并在“菜单->工程->引用”中添加“Microsoft HTML Object Library”
'' 为了简洁，程序仅下载九只个股的基本信息
Option Explicit
Private Const Form_ID = 1
Dim Code(9) As String
Dim Current As Long
Private Sub Form_Load()
  Form1.MousePointer = 11
  ' 以下是个股代码
  ' 为了程序简洁，这里仅使用九只代码。
  ' 而在真实环境中，应从数据文件中读入全部个股代码。
  Code(0) = "600001": Code(1) = "600002": Code(2) = "600003"
  Code(3) = "600005": Code(4) = "600006": Code(5) = "600007"
  Code(6) = "600008": Code(7) = "600009": Code(8) = "600010"
  Current = 0
  WebBrowser1.Navigate "www.stockstar.com.cn"  ' 起始网址
End Sub
Private Sub WebBrowser1_DocumentComplete(ByValpDisp As Object, URL As Variant)
  Dim i, k
  Text2 = WebBrowser1.LocationURL    ' 显示当前网址
  ' 判断当前网页是否全部调入完毕
  If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
  On Error Resume Next
  Select Case Text2
  Case "http://www.stockstar.com.cn/home.htm"  ' 当进入主页面时执行以下程序
  For i = 0 To WebBrowser1.Document.Forms(Form_ID).length - 1
      ' 找到代码输入框后填入个股代码
      If WebBrowser1.Document.Forms(Form_ID)(i).Name = "code" Then _
        WebBrowser1.Document.Forms(Form_ID)(i).Value = Code(Current)
      ' 在下拉式列表中进行选择
      If WebBrowser1.Document.Forms(Form_ID)(i).Name = "target" Then
        For k = 0 To WebBrowser1.Document.Forms(Form_ID)(i).length - 1
          If WebBrowser1.Document.Forms(Form_ID)(i).Options(k).Text _
                    = "个股资料" Then
            WebBrowser1.Document.Forms(Form_ID)(i).Options(k).Selected = True
            Exit For
          End If
        Next k
      End If
      ' 点击按钮
      If WebBrowser1.Document.Forms(Form_ID)(i).Value = " 查询 " Then _
        WebBrowser1.Document.Forms(Form_ID)(i).Click
  Next
  Case Else  ' 当进入数据页面时执行以下程序
  For i = 0 To WebBrowser1.Document.All.length - 1
      If WebBrowser1.Document.All(i).tagName = "PRE" Then
        ' 精确提取数据
        Text1 = Text1 + Code(Current) + vbCrLf + _
                WebBrowser1.Document.All(i).innerText + vbCrLf
        Exit For
      End If
  Next
  ' 数据存盘
  Open "C:\Data2.Txt" For Append As #1
  Print #1, Text1: Text1 = "": Close #1
  ' 换下一只股票
  Current = Current + 1
  If Current >= 9 Then
    ' 上网任务完成后，应在此调用自动挂断过程。
    Form1.MousePointer = 0: MsgBox "Finished!": End
  End If
  ' 回退到主页面，查询下一只股票的信息
  WebBrowser1.GoBack
  End Select
End Sub
第二部分  将网页上的二维表导入数据库
    在上一部分中，我们讨论了让程序自动在网上浏览并将所需的数据准确、快速地存储下来的方法。现在，我们将迎接更大的挑战：将网页上以表格形式存在的二维数据提取出来，并存成可直接导入数据库的“Microsoft Excel 逗号分隔值文件”（即.csv文件）。
    用手工在网页上直接提取类似上图中所示的表格数据是非常困难的。如果这样的表格有数十页甚至上百页之多，手工提取工作将是不可想象的，而且非常容易出错。
    本部分的实例是：将沪深两市全部约1100家个股的财务评分表数据（共54页，每页20家，如上图所示）快速、准确地转换成“.csv”文件。
1. 自动设置CheckBox的值
    由于只有注册用户才能访问上述财务评分表，因此实例程序首先演示了自动注册的功能。下图显示的是注册前以及自动注册后的画面。
    我们在上一部分中已讨论了自动填写输入区以及自动点击按钮等的方法。对于自动设置CheckBox值，其方法完全类似：首先要搜索到该CheckBox的名字，然后将该对象的Checked属性置为True或False即可。

2. 将网页上的二维表导入数据库
  首先定义一个IHTMLElementCollection对象用于收集网页上所有的 Table，然后用getElementsByTagName方法执行收集工作：

Dim Tables AsIHTMLElementCollection
  Set Tables = WebBrowser1.Document.getElementsByTagName("Table")
    一个网页上往往有多个 Table。我们用HTMLTable对象来处理每个Table：
Dim Table1 AsHTMLTable
    For Each Table1 In Tables
    Next
    HTMLTable对象的innerText属性记录了整个 Table的全部信息，包括字段名。因此我们可以根据字段名判断出哪个 Table是我们需要的。
    为了逐行逐列地提取数据，我们还需要HTMLTableRow对象和HTMLTableCell对象：
Dim Row AsHTMLTableRow, Cell As HTMLTableCell
    For i = 1 To Table1.rows.length - 1      ' 逐行处理
      Set Row = Table1.rows(i)
      j = 0
      For Each Cell In Row.cells      ' 逐列处理
          ' Row.cells(j).innerText即为当前行及当前列上的单元数据
          Text1 = Text1 + Trim(Row.cells(j).innerText) + ","
          j = j + 1
      Next
      ' 一行处理完毕后，去除行尾的逗号并加上回车
Text1 = Left(Text1, Len(Text1) - 1) + vbCrLf
    Next
    至此，当前网页上的二维表已转换成“.csv”格式。
3. 自动浏览时的页面控制技巧
    我们从上个例子中就已经清晰地看到，自动浏览程序的主体是WebBrowser控件的DocumentComplete事件。只有在当前页面已被完全调入后，我们才能开始对当前页面进行数据处理，然后再根据当前在哪个页面来决定下一步的浏览方向。
    需要指出的是，DocumentComplete事件的发生并不一定意味着当前页面已被全部调入。如果页面上没有其它子框架（frames），发生DocumentComplete事件即表明当前页面（即主框架）已完成调入；若页面上有多个框架，则每个框架完成时都会发生DocumentComplete事件；当所有子框架都完成后，主框架最后产生一次DocumentComplete事件。为了判断出这最后一次DocumentComplete事件，需要比较每次事件发生时的对象（pDisp）是否是WebBrowser控件对象本身：
Private Sub WebBrowser1_DocumentComplete(ByValpDisp As Object, _
                                            URL As Variant)
      If (pDisp Is WebBrowser1.Object) Then
        Debug.Print "Document is finished loading."
      End If
    End Sub
  下面是实例程序的完整代码（运行该程序可得到完整的1061行“.csv”格式的数据，分别代表1061个上市公司的财务信息。该文件可直接导入Access数据库或 Excel中。）：
' 程序二：将网页上的二维表导入数据库
'' 为运行本程序，应在“菜单->工程->部件”中添加“Microsoft Internet Controls”
' 并在“菜单->工程->引用”中添加“Microsoft HTML Object Library”
'Option Explicit
Dim Page As Long
Private Sub Form_Load()
Form1.MousePointer = 11
WebBrowser1.Navigate "www.stockstar.com.cn" ' 起始网址
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim Table1 As HTMLTable, Tables As IHTMLElementCollection
Dim Row As HTMLTableRow, Cell As HTMLTableCell
Dim i, j, tmp
Text2 = WebBrowser1.LocationURL ' 显示当前网址
' 判断当前网页是否全部调入完毕
If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
On Error Resume Next
Select Case Text2
Case "http://www.stockstar.com.cn/home.htm" ' 当进入主页面时执行以下程序
' 用户注册登录
For i = 0 To WebBrowser1.Document.Forms(0).length - 1
' 找到 CheckBox 后，将其值改为 False，以防止用户名及密码被存储
If WebBrowser1.Document.Forms(0)(i).Name = "checkSavePW" Then _
WebBrowser1.Document.Forms(0)(i).Checked = False
If WebBrowser1.Document.Forms(0)(i).Name = "userId" Then _
WebBrowser1.Document.Forms(0)(i).Value = "kompass_china"
If WebBrowser1.Document.Forms(0)(i).Name = "passwd" Then _
WebBrowser1.Document.Forms(0)(i).Value = "kompass1"
' 此处是按名字访问按钮（上例中是按值访问按钮）
If WebBrowser1.Document.Forms(0)(i).Name = "continue" Then _
WebBrowser1.Document.Forms(0)(i).Click
Next
Case "http://my.stockstar.com/scripts/mystockstar.dll?login"
' 当用户登录完成后，准备打开表格的第一页
WebBrowser1.Navigate "http://finance.stockstar.com/scripts/finance.dll?" + _
"showstkdfpm&begin=0&ret=1&index=2&concode=01"
Page = 1
Case Else ' 当进入数据页面（表格的第一页至最后一页）时执行以下程序
Set Tables = WebBrowser1.Document.getElementsByTagName("Table")
For Each Table1 In Tables
If Left(Table1.innerText, 2) = "名次" Then ' 找到需要的Table
' 将表格转换成“.csv”格式
For i = 1 To Table1.rows.length - 1
Set Row = Table1.rows(i)
j = 0
For Each Cell In Row.cells
Text1 = Text1 + Trim(Row.cells(j).innerText) + ","
j = j + 1
Next
Text1 = Left(Text1, Len(Text1) - 1) + vbCrLf
Next
' 数据存盘
Open "C:\Data.csv" For Append As #1
Print #1, Left(Text1, Len(Text1) - 2): Text1 = "": Close #1
Exit For
End If
Next
' 准备打开下一页
Page = Page + 1
tmp = "http://finance.stockstar.com/scripts/finance.dll?showstkdfpm&ret=" + _
Trim(Str(Page)) + "&index=2&concode=01"
If Page <= 54 Then ' 判断是否浏览结束
WebBrowser1.Navigate tmp
Else
' 上网任务完成后，应在此调用自动挂断过程。
Form1.MousePointer = 0
MsgBox "Finished!!": End
End If
End Select
End Sub
  以下给出的是上述程序所存数据文件的片段：
1,乐凯胶片,600135,材料,81.493,18.445,23.165,8.850,20.717,10.315
2,歌华有线,600037,传播娱乐,80.553,13.009,22.256,12.141,20.304,12.844
3,外运发展,600270,仓储运输,80.326,17.331,23.005,8.829,19.900,11.261
4,东方钽业,0962,有色金属,80.312,15.160,22.483,11.648,21.290,9.730
5,双汇发展,0895,食品,79.772,15.428,20.673,11.508,20.235,11.930
6,四川美丰,0731,化肥,79.361,15.795,23.235,11.323,16.921,12.088
1059,轮胎橡胶,600623,车类,7.167,8.265,10.973,-34.411,14.120,8.219
1060,PT吉轻工,0546,日用轻工产品,-11.895,5.740,-49.149,7.999,14.136,9.379
1061,广船国际,600685,机械仪器,-57.452,9.824,-1.528,-89.648,14.366,9.533