如果获取一个html网页表格中的数据并存入sqlserver2000数据库 -------高手请进 现场结分

[lyit]

比如，我打开一个html网页，这个网页有个表格，这个表格有固定 四列 有 任意行
如何用VB获取这表格中的数据，并存入数据库，谢谢
我以前接触过，听说是用WebBrowser来做，但具体做法不是太熟悉，请给出源代码
不盛感激

[蒋晟]

http://dev.csdn.net/article/50/50960.shtm

[lyit]

各位仁兄， 帮帮忙吧，小弟在这里，致谢了

[aohan]

up

[ezlj]

就是用shdocvw.dll和mshtml.dll然后分析遍历网页内含标记table的对象，然后再取数据，楼上的资料很多了自己看吧，如果还不行可以上e文的msdn，资料很多的。这段时间我也在用mshtml

[online]

http://dev.csdn.net/develop/article/17/17697.shtm

程序一：从网页上精确提取数据
'
' 为运行本程序，应在“菜单->工程->部件”中添加“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

[lyit]

我说的是一个HTML页面的表格中的数据，怎么抓取

[hongonline]

那就要跟表格中数据出现的规律，用instr(）和mide()查找截取两个点之间的数据
比如在<td>中间的数据</td>,你就应该先确定<td>和</td>的位置，然后就可以取出了

[wwqna]

'我以前写的，如果要针对某个网页当然还得改一下了

Private Sub Command1_Click()
Dim vDoc, vTag, coll
Dim i As Integer
Dim j As Integer
Set vDoc = ie.Document
Dim mstrcell As String
Set coll = vDoc.All("19")
For i = 0 To coll.rows.length - 1
For j = 0 To coll.rows(i).cells.length - 1
mstrcell = mstrcell & Space(4) & coll.rows(i).cells(j).innertext
Next j
Debug.Print mstrcell
mstrcell = ""
Next i
End Sub

Private Sub Form_Load()
ie.Navigate "E:\1.htm"
End Sub


htm内容

<TABLE id=19 BORDER=1 WIDTH=80%>
<THEAD>
<TR>
<TH>Heading 1</TH>
<TH>Heading 2</TH>
</TR>
</THEAD>
<TBODY>
<TR>
<TD>Row 1, Column 1 text.</TD>
<TD>Row 1, Column 2 text.</TD>
</TR>
<TR>
<TD>Row 2, Column 1 text.</TD>
<TD>Row 2, Column 2 text.</TD>
</TR>
</TBODY>
</TABLE>

[jincaogg]

采用 TXT读去可行吗？

[hnhou]

2003年的电脑报上有这个一编文章，如果你还没解决我可以帮你找一下

[rockrabbit]

good

[笨笨兔兔兔兔兔]

set ttt=webbrowser1.document.getElementsByTagName("table")
for i=0 to ttt(0).rows.length-1
for j=0 to ttt(0).rows(i).cells.length
a=ttt(0).rows(i).cells(j).innerText
insert into ......
next
next

[smile8088]

以前写过一个读取中央电视台天气预报的程序，可以参考一下，希望能帮到你！

1 新建一个工程，部件--引用“Microsoft intternet transfer control 6.0”,添加一个列表框及一个按钮.

===============================================================================

Dim TQ, Pic As String

Private Sub Download(UrtFile As String, LocalFile As String)
Dim bData() As Byte '数据变量
Dim intFile As Integer '可用文件变量
Dim i As Integer
Dim ttt As String
intFile = FreeFile() '将 intFile 设置为未使用的文件
' OpenURL 方法的结果首先传入 Byte 数组，
'然后将 Byte 数组保存到磁盘。
On Error Resume Next
Kill LocalFile
On Error GoTo Err1
bData() = Inet1.OpenURL(UrtFile, icByteArray)
Open LocalFile For Binary Access Write As #intFile
Put #intFile, , bData()
Close #intFile
Exit Sub
Err1:
MsgBox Err.Description & " -- " & Err.Number
Err.Clear
End Sub


Private Sub Command1_Click()
On Error Resume Next
Dim sUrt As String
Dim i, j As Integer
Dim SS, Msg, TempMsg As String
sUrt = "http://www.cctv.com/weather/city_china.js"
Download sUrt, App.Path & "\1.tmp"
Msg = ""
i = 1
List1.Clear
Open App.Path & "\1.tmp" For Input As #1
Do While Not EOF(1)
Line Input #1, t1
If InStr(t1, ";") > 0 And Left(t1, 3) = "cw[" Then
Msg = Msg & t1 '& vbCrLf
Msg = Replace(Msg, "cw[" & i & "]=new today_weather", "")
Msg = Trim(Replace(Msg, "'", ""))
Msg = Trim(Replace(Msg, "(", ""))
Msg = Trim(Replace(Msg, ")", ""))
i = i + 1
End If
Loop
Close #1

TempArr = Split(Msg, ";")
For j = 0 To UBound(TempArr) - 1
MyArr = Split(TempArr(j), ",")
List1.AddItem " " & MyArr(0) & " " & MyArr(1) & " " & MyArr(2) & MyArr(5) & " 到 " & MyArr(4) & " " & MyArr(6) & " "
Next
End Sub

============================================================