word VBA利用正则网抓数据

duquancai

刚学“网抓”，写了一个代码，恳请大神们指教一下，万分感谢！！！
Sub 网抓wordvba正则运用()
    Dim mt, mts As Object, m$, n%, i%
    Dim reg As Object, xDOC As Object
    Set xDOC = CreateObject("msxml2.xmlhttp.6.0")
    Set reg = CreateObject("VBscript.regexp")
    With xDOC
        .Open "GET", "http://fund.eastmoney.com/f10/F10DataApi.aspx?type=lsjz&code=000389&page=1&per=35", False
        .send
        m = .responseText
        With reg
            .Global = True: .IgnoreCase = False
            .Pattern = "(?:\d+[.-]\d+-*\d+%?)|净值日期|每万份收益|7日年化收益率（%）"
            Set mts = .Execute(m)
            n = mts.Count / 3
            With ActiveDocument
                .Tables.Add .Range(0, 0), n, 3
                .Tables(1).Style = "网格型"
                For Each mt In mts
                    i = i + 1
                    .Tables(1).Range.Cells(i).Range.Text = mt
                Next
            End With
        End With
    End With
    Set xDOC = Nothing: Set reg = Nothing
End Sub

ljchb

谢谢分享！

duquancai

Sub wordVBA网抓实例()
    Dim mt, mts As Object, m$, n%, i%, k%
    Dim reg As Object, xDoc As Object
    Set xDoc = CreateObject("msxml2.xmlhttp.6.0")
    Set reg = CreateObject("VBscript.regexp")
    Documents.Add
    With xDoc
        For k = 1 To 3 '抓取3页数据，根据实际需要更改
            .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
            .setRequestHeader "Content-Type", "application/json; charset=utf-8"
            .setRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
            .send "{pageindex:'" & k & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
            m = .responseText
            With reg
                .Global = True: .IgnoreCase = False
                .Pattern = "(?:开奖时间|期号|开奖号码)|(?:\d{4}-\d{2}-\d{2})|\d{7}(?!%)"
                Set mts = .Execute(m)
                n = mts.Count / 3
                With ActiveDocument
                    .Tables.Add Selection.Range, n, 3
                    .Tables(k).Style = "网格型"
                    For Each mt In mts
                        i = i + 1
                        .Tables(k).Range.Cells(i).Range.Text = mt
                    Next
                End With
            End With
            Selection.EndKey wdStory
            Selection.Range.InsertAfter Chr(13)
            Selection.EndKey wdStory
            i = 0
        Next
    End With
    Set xDoc = Nothing: Set reg = Nothing
End Sub

xyz74sc

为什么不用excel，word的表格处理能力比excel差了不只一点点

周星骋

duquancai ，你 Excel 网抓都玩腻了呀，现在又搞起 Word 网抓了，恐怕为数不多的人才做这种触类旁通、举一反三的事。
真不愧是全才。

lihui8171012

http://club.excelhome.net/thread-1308224-1-1.html请老师帮忙看看！谢谢！