huang1314wei申请担任 “ExcelVBA程序开发”版版主——申请成功

周周周周周

周周周周周 发表于 2017-11-3 15:42
黄老师，我在版块中找到一个可以在网页上批量复制粘贴到EXCEL中的程序，但我复制的是内网，要用户名和密码 ...

Declare Function GetTickCount Lib "kernel32" () As Long

'‘http://117.21.249.37:9090/yzcg/jxyycg/search/bidCatalog.shtml?dypn=1
    Sub tttt()
        Dim HTML, URL, K, X, No
        Cells.Clear
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Set HTML = CreateObject("htmlfile")
        K = 1
        No = 4    '总页数
        
        ParShow.Show 0    '进度条窗口显示
        With CreateObject("msxml2.xmlhttp")
        For X = 0 To No
        
        URL = "https://http://1*.***.**1.***//flowtranslist.html?fid=10010401&mid=1001 &start=" & X
        
            .Open "get", URL, False
            .Send
            DelayTime (2000)      '延时，网速不好改大
            HTML.body.innerhtml = .responsetext
            Set tb = HTML.ALL.tags("tbody")(0)
            For I = 1 To tb.Rows.Length - 1
                For j = 0 To tb.Rows.Item(I).Cells.Length - 1
                    Cells(I + K, j + 1) = tb.Rows(I).Cells(j).innertext
                Next
            Next

        K = K + tb.Rows.Length - 1
        Set tb = Nothing
        ParShow.LblNote.Caption = "正在抓取第" & X & "页！！"
        ParShow.lblProgress.Width = Int((X / No) * ParShow.lblBack.Width) '标签宽度
        ParShow.lblPercent.Caption = Format(Int((X / No) * 100), "0") & "%" '完成百分比
        'ParShow.Repaint                                             '窗体重绘
        DoEvents
        
        Next X
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

        Set tb = Nothing
        Unload ParShow
        MsgBox "数据抓取完成！"
         End With
    End Sub

Sub DelayTime(DTime As Long)        '延时

    SaveTime = GetTickCount
    While GetTickCount < SaveTime + DTime '等待1S
        DoEvents
    Wend
End Sub

运行到.send就提示错误，应该是需要用户名和密码的原因，怎么改?

huang1314wei

周周周周周 发表于 2017-11-3 15:42
黄老师，我在版块中找到一个可以在网页上批量复制粘贴到EXCEL中的程序，但我复制的是内网，要用户名和密码 ...

网抓不分内网外网的，只要能打开网页，分析网页内容就可以网抓的

dengjq2000

我就不支持了！呵呵……
只表祝福！

xuanmuluck

原来黄大仙是版主...

Emily2019

可以帮我删一个帖子么？

ndt3

厉害，我就学点怎么改看的懂的代码，学了点嫁接

ndt3

huang1314wei 发表于 2017-11-3 16:14
网抓不分内网外网的，只要能打开网页，分析网页内容就可以网抓的

黄老师，能帮忙看下以前您写的代码怎么改么？谢谢您。
http://club.excelhome.net/forum. ... ;extra=#pid10377489

Kaitou_Kiddo

恭喜恭喜恭喜恭喜恭喜

cdg001

支持大神！

我不能熬夜

大佬你好，拜读了您19年写的VBA抓取快递100的订单信息，是否能写一个抓取17track 返回最后一条的VBA呢