管理首页
用VB写简单网络信息采集软件
经常上网找一些客户资料,经常要把资料复制、粘贴到EXCEL表格中。累,麻烦,用过几款网络采集软件,但都要付费。看到付费的采集软件就来火,自己写吧,功能有点简单,但实用就行。
准备工作 vb 6.0/ windowsxp/ ms-access/ Inet1控件/command控件
打表MS access 新建一数据库,根据需要添加字段。
打开VB6.0 新建一工程,在表单中放入一Inet1控件和command控件,
Function strCut(strContent, StrStart, StrEnd) As String '通用截取函数
Dim strHtml, S1, S2 As String
strHtml = strContent
On Error Resume Next
S1 = InStr(strHtml, StrStart) + Len(StrStart)
S2 = InStr(S1, strHtml, StrEnd)
strCut = Mid(strHtml, S1, S2 - S1)
End Function
command1 click事件代码如下:
Private Sub command1_Click()
Dim tempstr As String, astr As String, website As String
Dim counter As Integer
For counter = 455 To 2000 '定义采集网页,采集:a.asp?id=455 到 a.asp?id=2000,可自行修改
website = Inet1.OpenURL("http://www.zgzbsjh.com/zb23/web/co_contact.asp?Co_ID=" & counter) '下载此网页 可自行修改
astr = Trim(website) '定义astr内容为网页内容
StringNoSpaces = Replace(astr, vbCrLf, "") '替换网页源码中的换行符
Dim hunzi1, hunzi2, hunzi3, hunzi4, hunzi5, hunzi6, hunzi7 As String
hunzi1 = strCut(StringNoSpaces, " | ", " | ")
hunzi2 = strCut(StringNoSpaces, "联 系 人: ", " | ")
hunzi3 = strCut(StringNoSpaces, "邮政编码: ", " | ")
hunzi4 = strCut(StringNoSpaces, "联系电话: ", " | ")
hunzi5 = strCut(StringNoSpaces, "传 真 : ", " | ")
'hunzi6 = strCut(StringNoSpaces, "电子邮件: | ", " | ")
'写入数据库
Dim Conn
Dim ConnectionString As String
Set Conn = CreateObject("ADODB.Connection")'连接数据库
Conn.Open "provider=Microsoft.Jet.oledb.4.0;" & "data source=D:\beijing\vb\caiji\caiji.mdb" '
Dim rs As New ADODB.Recordset
SQL = "select * from caiji"
rs.Open SQL, Conn, 3, 3
rs.AddNew '增加新记录 可自行添加,
rs("公司") = hunzi1
rs("联系人") = hunzi2
rs("手机") = hunzi3
rs("电话") = hunzi4
rs("传真") = hunzi5
'rs("邮件") = hunzi6
rs("地址") = hunzi7
rs.Update '保存记录
Set rs = Nothing
Set Conn = Nothing
End Sub
到这里,网页上的客户信息都采集到caiji.mdb数据库中,再用MS ACCESS软件导出到excel就完事了,不用再复制,粘贴这么麻烦又重复的工作。