您的位置：首页 > 编程语言 > VB

[vb]提取网页中表格内容

2007-07-21 19:14 246 查看
在网页html代码

<html>
<table width="200" border="0" cellpadding="0" cellspacing="0" id="xyf">
<tr>
<td >姓名</td>
<td>学历</td>
<td>籍贯</td>
</tr>
<tr>
<td id=xiaoxing1>小红</td>
<td id=xiaoxing2>研究生</td>
<td id=xiaoxing3>北京</td>
</tr>
<tr>
<td id=xiaofeng1>小奉</td>
<td id=xiaofeng2>本科</td>
<td id=xiaofeng3>上海</td>
</tr>
</table>
</html>

中提取出如下内容:
姓名 学历 籍贯
小红 研究生 北京
小奉 本科 上海

'两textbox，text1是html代码，text2是输出
'代码如下

Option Explicit

Private Sub Command1_Click()
Dim asTable() As String
Dim lRow As Long
Dim lColumn As Long
Dim i As Long
Dim j As Long
Call ReadHtmlTable(Text1.Text, asTable, lRow, lColumn)
For i = 0 To lRow
For j = 1 To lColumn
Text2.SelStart = 65535
Text2.SelText = asTable(i * lColumn + j - 1) & vbTab
'Debug.Print "asTable("; i * lColumn + j - 1; ")"
Next
Text2.SelStart = 65535
Text2.SelText = vbCrLf
Next
End Sub

Private Sub ReadHtmlTable(ByRef sHtml As String, _
ByRef asTable() As String, _
ByRef lRow As Long, _
ByRef lColumn As Long)

Dim lTablePos As Long
Dim lEndTablePos As Long
Dim lTRPos1 As Long
Dim lTRPos2 As Long
Dim lEndTRPos As Long
Dim sTDContent As String
Dim asTD() As String
Dim lCount As Long
Dim bContinue As Boolean
Dim i As Long

lTablePos = InStr(1, sHtml, "<table", vbTextCompare)
If lTablePos <= 0 Then Exit Sub
lTablePos = InStr(lTablePos, sHtml, ">", vbTextCompare)
lEndTablePos = InStr(lTablePos, sHtml, "</table>", vbTextCompare)
lTRPos1 = InStr(lTablePos, sHtml, "<tr", vbTextCompare)
lTRPos2 = InStr(lTRPos1 + 1, sHtml, ">", vbTextCompare)
lEndTRPos = InStr(lTablePos, sHtml, "</tr>", vbTextCompare)
If lTRPos1 <= 0 Then Exit Sub
bContinue = True
While bContinue
bContinue = True
If lTRPos1 < lTablePos Or lTRPos1 > lEndTablePos Then bContinue = False
If lEndTRPos < lTablePos Or lEndTRPos > lEndTablePos Then bContinue = False
If bContinue Then
sTDContent = Mid(sHtml, lTRPos2 + 1, lEndTRPos - lTRPos2 - 1)
Call ReadHtmlTD(sTDContent, asTD, lCount)
lColumn = lCount + 1
For i = 0 To lCount
ReDim Preserve asTable(lRow * lColumn + lColumn)
asTable(lRow * lColumn + i) = asTD(i)
Debug.Print "asTable("; lRow * lColumn + i; ") = asTD("; i; ")"
'Debug.Print asTD(i),
Next
lRow = lRow + 1
Debug.Print
lTRPos1 = InStr(lTRPos1 + 1, sHtml, "<tr", vbTextCompare)
lTRPos2 = InStr(lTRPos1 + 1, sHtml, ">", vbTextCompare)
lEndTRPos = InStr(lTRPos2 + 2, sHtml, "</tr>", vbTextCompare)
End If
Wend
lRow = lRow - 1
End Sub

Private Sub ReadHtmlTD(ByRef sHtml As String, _
ByRef asTD() As String, _
ByRef lCount As Long)
Dim lTDPos1 As Long
Dim lTDPos2 As Long
Dim lEndTDPos As Long
Dim lLen As Long
lLen = Len(sHtml)

Dim bContinue As Boolean

lCount = 0
lTDPos1 = InStr(1, sHtml, "<td", vbTextCompare)
lEndTDPos = InStr(lTDPos1 + 1, sHtml, "</td>", vbTextCompare)
lTDPos2 = InStr(lTDPos1 + 1, sHtml, ">", vbTextCompare)
If lTDPos1 <= 0 Then Exit Sub
bContinue = True
While (bContinue)
bContinue = True
If lTDPos1 <= 0 Or lTDPos1 > lLen Then bContinue = False
If lEndTDPos <= 0 Or lEndTDPos > lLen Then bContinue = False
'Debug.Print Mid(sHtml, lTDPos2 + 1, lEndTDPos - lTDPos2 - 1)
If bContinue Then
lCount = lCount + 1
lTDPos1 = InStr(lTDPos1 + 1, sHtml, "<td", vbTextCompare)
lTDPos2 = InStr(lTDPos1 + 1, sHtml, ">", vbTextCompare)
lEndTDPos = InStr(lTDPos1 + 1, sHtml, "</td>", vbTextCompare)
End If
Wend

ReDim asTD(lCount + 1) As String
lCount = 0
bContinue = True
lTDPos1 = InStr(1, sHtml, "<td", vbTextCompare)
lEndTDPos = InStr(lTDPos1 + 1, sHtml, "</td>", vbTextCompare)
lTDPos2 = InStr(lTDPos1 + 1, sHtml, ">", vbTextCompare)
While (bContinue)
bContinue = True
If lTDPos1 <= 0 Or lTDPos1 > lLen Then bContinue = False
If lEndTDPos <= 0 Or lEndTDPos > lLen Then bContinue = False
asTD(lCount) = Mid(sHtml, lTDPos2 + 1, lEndTDPos - lTDPos2 - 1)
If bContinue Then
lCount = lCount + 1
lTDPos1 = InStr(lTDPos1 + 1, sHtml, "<td", vbTextCompare)
lTDPos2 = InStr(lTDPos1 + 1, sHtml, ">", vbTextCompare)
lEndTDPos = InStr(lTDPos1 + 1, sHtml, "</td>", vbTextCompare)
End If
Wend
lCount = lCount - 1
End Sub
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 点击这里给我发消息
标签： 
相关文章推荐
新的分享
章节导航