设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 123|回复: 2

[Excel VBA] 关于网抓,文件下载,文件操作

[复制链接]
发表于 2018-1-12 17:11:55 | 显示全部楼层 |阅读模式
  • 署名作者: jashion
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2013 2010 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    本帖最后由 jashion 于 2018-1-12 17:13 编辑

    最近一直在用vba做开发,把这次开发的一些知识记录下来,留给自己和可能需要这些知识的人一起看。
    这次开发主要涉及从网站下载文件保存到本地,对压缩文件解压提取,操作远程共享文件夹 等等。接下来我会细说。

    一、 抓取网页信息。
    对于网抓我使用的是msxml2.xmlhttp,具体使用方法就不说了。
        Set XML_HTTP = CreateObject("msxml2.xmlhttp")

        With constant.XML_HTTP
            .Open "post", constant.WEB_SEARCH__URL, False
            .setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded; charset=utf-8"
            .setRequestHeader "Content-Length", Len(param)
            .send param
            Do Until .ReadyState = 4
                DoEvents
            Loop
            
            responseText= .responseText
        End With
    利用post请求,获取网页数据 responseText。param为你要提交的参数 例如 param="useranme=" & username & "&password=" & password


    二、获取所要数据

    我在做在下载文件的时候需要提交参数到网站后台(当然,你需要知道文件下载的地址),这时候就需要获取网页的一些数据来提交。具体提交什么数据,需要你自己先手动抓取一下数据然后分析。我用的火狐浏览器,如下:
    图像 3.jpg
    知道你需要提交的数据,那么就来解析所得的responseText吧。

    Private Function getPostData(responseText)
        Set html = CreateObject("htmlfile")

        With html
            .body.innerHTML = responseText

            TOKEN = .All("TOKEN").Value
            username= .All("username").Value
            password= .All("password").Value
        End With
       
        getPostData = "TOKEN=" & TOKEN & "&username=" & username& "&password=" & password

        Set html = Nothing
    End Function

    首先创建htmlfile对象,将responseText写入。然后就可以用js获取表单的值的方法,来获取数据。
    getElementsByName("name")
    getElementByid("id")
    ....
    注意,如果表单name有重复,那么html.All后面就不能写.value。可以创建一个对象 ,然后遍历这个对象就可以获得每个值。

        Set obj = html.All(name)
        For Each Item In obj
              debug.Print   Item.Value
        Next

        Set obj=nothing
    最后将所得到的数据拼接起来返回。这样数据就获取完成。

    三、下载文件
    大部分网站是将文件流写入response中,我们请求url的时候,浏览器把response的文件流获取到,然后弹出保存或者下载框,让你下载文件。
    这里也是一样。

    Function downloadFile(postData)

        With constant.XML_HTTP
            .Open "post", constant.WEB_DOWNLOAD_URL, False
            .setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded; charset=utf-8"
            .setRequestHeader "Content-Length", Len(postData)
            .send postData
            Do Until .ReadyState = 4
                DoEvents
            Loop

            responstHeader = .getallresponseheaders
            fileArr = Split(responstHeader, "filename=")
            fileName = Split(fileArr(1), """")
            filePath = constant.DOWNLOAD_FOLDER & fileName(1)
            commonFunction.writeIntoFile .responseBody, filePath
        End With
    End Function
    同样,post提交方式,将数据提交到网站,重点是返回的responseheaders和responseBody。
    利用getallresponseheaders可以获得所有响应头。如果参数提交成功,服务器正常返回数据,那么文件名就会在这响应头了,这时候就需要你自己去解析,提取出文件名。那么responseBody就是所要的文件流了。接下来将文件保存在本地。

    Public Function writeIntoFile(fileStream, fileName)
       
        With CreateObject("ADODB.Stream")
            .Type = 1
            .Open
            .Write fileStream
            .SaveToFile fileName, 2
            .Close
        End With
       
    End Function

    创建 ADODB.Stream对象,详细的也不说了,把保存的文件路径和文件流传入就可以了。
    我在下载文件经常遇到 msxml2.xmlhttp 返回状态码 500 ,主要是因为我在拼接参数的时候,参数拼接不对,如果大家遇到这种情况,请好好检查参数拼接。 状态有很多种,根据返回的状态码判断什么原因,这个还得靠你自己理解了。


    四、解压文件
    我下载的文件有的是zip压缩文件,那么就需要你自己解压缩。百度很多方法,当然,我这个方法也是百度的。
    Public Function unzipFile(filePath)
       
        Dim ShellApp As Object
        Dim TargetFile, ZipFolder
       
        TargetFile = filePath
        If TargetFile = False Then Exit Function
        zipfolderArr = Split(filePath, ".")
        ZipFolder = zipfolderArr(0)
        On Error Resume Next
        RmDir ZipFolder
        MkDir ZipFolder
        On Error GoTo 0
        Set ShellApp = CreateObject("Shell.Application")
        ShellApp.Namespace(ZipFolder).CopyHere ShellApp.Namespace(TargetFile).items
        Set ShellApp = Nothing
    End Function

    最终会以你的压缩包名创建文件夹保存文件。

    五、操作共享文件夹
    Private Function connectSharedFolder(serverUrl, username, password)
        On Error GoTo err
        Set NetworkObject = CreateObject("WScript.Network")
        NetworkObject.MapNetworkDrive "", serverUrl, False, username, password
        Set NetworkObject = Nothing
    End Function
    可以百度vb WScript.Network

    剩下对文件的操作,Scripting.FileSystemObject 基本都可以做了,具体用法网上也是一大堆。

    总结:东西是死的,但是你把它用活了,那才是你的本事。


    评分

    参与人数 1魅力值 +5 收起 理由
    0Mouse + 5 感谢分享!

    查看全部评分

     楼主| 发表于 2018-1-12 17:20:02 | 显示全部楼层
    图像 4.jpg 所有引用


    回复 支持 反对

    使用道具 举报

    发表于 7 天前 | 显示全部楼层
    谢谢分享
    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

    GMT+8, 2018-1-20 11:06

    Powered by Discuz! X3.3

    © 2001-2017 Comsenz Inc.

    快速回复 返回顶部 返回列表