form1.frm

从网站获取股票信息分析的代码

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.dll"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4875
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8175
   LinkTopic       =   "Form1"
   ScaleHeight     =   4875
   ScaleWidth      =   8175
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   4440
      TabIndex        =   2
      Top             =   840
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   4440
      TabIndex        =   1
      Top             =   360
      Width           =   3135
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   1695
      Left            =   480
      TabIndex        =   0
      Top             =   1920
      Width           =   2175
      ExtentX         =   3836
      ExtentY         =   2990
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   720
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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(ByVal pDisp 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
      Debug.Print WebBrowser1.Document.Forms(form_id)(i).Value
      ' 点击按钮
      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
   Debug.Print current
   If current >= 9 Then
    End
   End If
   ' 回退到主页面，查询下一只股票的信息
   WebBrowser1.GoBack
  End Select
End Sub