[分享]网页数据下载与控制

gdjxwz

Sub bbb()

    Dim weburl As String, Strpost As String

    weburl = "URL;http://www.autoinfo.gov.cn/app/cpzz/qcxx.jsp?wenjian=kc"
    Strpost = "cllb=6&zw=kc&file=kc&cpsb=&cpxh=&cpmc=&pici=&qymc=&cp_id=96904"

    With ActiveSheet.QueryTables.Add(Connection:=weburl, Destination:=Range("a1"))
        .PostText = Strpost
        .BackgroundQuery = True
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "7"
        .WebFormatting = xlWebFormattingAll
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

End Sub

红色过不了：不能下载你所要求的网页内容。 Strpost中差参数？

[此贴子已经被作者于2008-3-4 14:34:40编辑过]

gdjxwz

Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Sub QueryStr()
Dim strQuery As String
Dim httpRequest As MSXML2.XMLHTTP30
Dim txtContent As String
Dim strBuffer As String
Dim lngBufferSize As Long
Dim lngResult As Long
Dim arrByte() As Byte
Dim lSize As Long
Dim l As Long

strQuery = "cllb=6&zw=kc&file=kc&cpsb=&cpxh=&cpmc=&pici=&qymc=&cp_id=96904"

Set httpRequest = New MSXML2.XMLHTTP30
httpRequest.Open "POST", "http://www.autoinfo.gov.cn/app/cpzz/qcxx.jsp?wenjian=kc", False
httpRequest.setRequestHeader "Content-Type", "text/html"
httpRequest.send strQuery
If httpRequest.Status = 200 Then
    ReDim arrByte(UBound(httpRequest.responseBody)) As Byte
    For l = 0 To UBound(httpRequest.responseBody)
        arrByte(l) = httpRequest.responseBody(l)
    Next l
    lngBufferSize = (UBound(arrByte) + 1) * 2
    strBuffer = String$(lngBufferSize, vbNullChar)
    lngResult = MultiByteToWideChar(936, 0, arrByte(0), lngBufferSize / 2, StrPtr(strBuffer), lngBufferSize)
    txtContent = Left(strBuffer, lngResult)
    'MsgBox txtContent
    Cells(1, 1) = txtContent
Else
    reportErr (httpRequest.Status)
End If
httpRequest.abort
Set httpRequest = Nothing
End Sub

程序倒是能顺利通过，但查询出来的没有什么实质内容

gdjxwz

WebBrowser:

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim aaa As Integer
If WebBrowser1.ReadyState <> READYSTATE_COMPLETE Then Exit Sub
WebBrowser1.Document.forms(1).Item(0).Checked = True
WebBrowser1.Document.forms(1).Item(1).Checked = True
WebBrowser1.Document.forms(1).Item(2).Checked = True
WebBrowser1.Document.body.All("Submit2").Submit

End Sub
按钮点击不支持。不关是WebBrowser1.Document.body.All("Submit2").Submit不能通过，将这句删除后，手动点击“详细参数”都没反应。

[此贴子已经被作者于2008-2-29 16:31:27编辑过]

winland

这个网页里递交数据的方法比较奇怪点。还有本身这个处理也太非常复杂的，339页要获取每页中的汽车型号，然后再获取这个型号汽车的详细资料。最近没什么时间啊。

fanrong88

学习

宏粉丝

正想写一个这类的，这下可好了^^谢谢楼主分享~~

tianying

学习一下

gdjxwz

QUOTE:

以下是引用winland在2008-3-1 0:03:37的发言：
这个网页里递交数据的方法比较奇怪点。还有本身这个处理也太非常复杂的，339页要获取每页中的汽车型号，然后再获取这个型号汽车的详细资料。最近没什么时间啊。

那就先获取一个详细资料了，也让我们知道获取的方法。至于其余的338个，不过是数字而已。

[此贴子已经被作者于2008-3-3 14:25:48编辑过]

gdjxwz

1MLEHqdF.rar (13.92 KB, 下载次数: 434)

2008-3-4 14:06 上传

点击文件名下载附件
[分享]网页数据下载与控制

用VB做了一个。

VB中用webbrowse可以做，试一下，只做了下载前三个车辆详细信息的例子。

运行环境：VB 6，如果没有环境，可运行EXE 。

全部下载应该不难了，VB6和VBA的使用差不多。

[此贴子已经被作者于2008-3-4 14:14:50编辑过]

ah2005

小弟佩服啊，好高深哦