网页抓取分享

onlycxb

喜欢网抓的看似不多。今天暂分享至此

marchwen01

驻足学习.那些createobject为什么都不一样的?想了解,不得其法啊!

choesehae

师傅一出手,就知有没有!顶

onlycxb

http://club.excelhome.net/thread-975124-1-1.html
该文有介绍

１、XmlHttp对象法——服务器上的抓取（比较适用于无防盗链）
２、InternetExplorer对象法——浏览器上的抓取（比较适用于服务器的脚本有ＣＯＯＫＩＥ要求的、服务器有防盗链）
３、ScriptControl对象法——显示器上的抓取（比较适用于浏览器的脚本有ＣＯＯＫＩＥ要求的、浏览器有防盗链）
４、QueryTables对象法——链接器上的抓取（Web的综合性运用，直接和间接QT）
其中：在显示器环节上的抓取（第三种下载到本地的做法），是实现“只要看得到，就能抓得到”的最简易、最无障碍的“全能通”方法，网抓必学DD。
ＸＨ抓不下来，那就可能服务器有防盗链，就用ＩＥ法；ＩＥ抓不下来，那就可能浏览器有防盗链，就用脚本法；最后，首选ＱＴ抓数据，因为ＱＴ最快，数据最不会误错。

onlycxb

czh7971 发表于 2014-10-14 09:02
大神啊，能否指示下怎么获得这些链接呢？

fiddler工具分析，取得真实地址。

VBA万岁

onlycxb 发表于 2014-10-14 10:16
分享4：论坛问题http://club.excelhome.net/thread-1158114-1-1.html
         抓取东方财富网数据

第7句代码“xml As New MSXML2.XMLHTTP”出错，弹出的错误提示为“User-defined-type not defined”——是否需要添加什么引用？还是需要下载安装什么东东？

VBA万岁

VBA万岁 发表于 2014-10-14 12:07
第7句代码“xml As New MSXML2.XMLHTTP”出错，弹出的错误提示为“User-defined-type not defined”——是 ...

我这里改为如下代码时运行正常：
'Option Explicit
'************************************************************
'作　　者：　DongYu  QQ:470208739    2014/10/14
'************************************************************
Sub 沪深A股()
'需求：抓取http://data.eastmoney.com/cmjzd/，抓取沪深A股
    Dim strTxt As String, Url As String, js, Slen As Integer
    Dim i As Integer, arr, j
    Cells.ClearContents
    Url = "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=GG&sty=GDRS&st=2&sr=true&p=1&ps=50&js=var%20ZWsofIjH={pages:(pc),data:[(x)]}&mkt=1&fd=2014-9-30&rt=47108232"
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Url, False
        .send
        strTxt = Split(.responseText, "var ZWsofIjH=")(1)
    End With
    Set js = CreateObject("scriptcontrol")
    js.Language = "jscript"
    js.AddCode ("dy= " & strTxt)
    Slen = js.eval("dy.data.length") - 1
    ReDim arr(1 To Slen + 1, 1 To 14)
    For i = 0 To Slen
        For j = 1 To 12
            arr(i + 1, j) = Split(js.eval("dy.data[" & i & "]"), ",")(j - 1)
        Next j
    Next i
    With Sheet1
        .[b2].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
        For i = 2 To UBound(arr, 1) + 1
            .Cells(i, 1) = i - 1
            .Cells(i, 2).NumberFormatLocal = "000000"
            If Abs(.Cells(i, 5)) > 1 Then .Cells(i, 5) = "-" Else .Cells(i, 5).NumberFormatLocal = "0.00%"
            .Cells(i, 6) = Round(.Cells(i, 6))
            '其他省略..
        Next i
    End With
End Sub

VBA万岁

VBA万岁 发表于 2014-10-14 12:31
我这里改为如下代码时运行正常：
'Option Explicit
'********************************************* ...

Mark如附件：
东方财富网网页抓取.zip (1.86 MB, 下载次数: 225)

2014-10-14 14:34 上传

点击文件名下载附件

ghostjiao

VBA万岁 发表于 2014-10-14 12:07
第7句代码“xml As New MSXML2.XMLHTTP”出错，弹出的错误提示为“User-defined-type not defined”——是 ...

对象有前期引用和后期创建两种方式dim ... as new ... 作为前期引用方式，引用图片所示的库就可以了
前期引用还是有很多优势的，比如可以主动显示属性、方法等，方便记忆书写。、
当然为了他人也能方便使用，一般是先前期引用写完代码后，再改为后期创建

PS：当然对于对象很熟悉的话，直接后期创建还是很方便的

VBA万岁

ghostjiao 发表于 2014-10-14 15:11
对象有前期引用和后期创建两种方式dim ... as new ... 作为前期引用方式，引用图片所示的库就可以了
前期 ...

测试通过，多谢指点！