用VBA批量下載文件

02-10

先表明一下背景相關。

本人是財務，不是程序員。

所在公司不能裝任何軟體，不能插U盤，連輸入法都只能用智能ABC。。。

本文圖片可能涉及公司一些信息，所以公司名字和賬戶名都打了碼。

----------------------------------------------

公司每天需要下載大概幾百個銀行賬單文件（且還在不停的增加中）。

下載的銀行文件需要每天及時和系統數據進行對賬。

自動對賬程序在我入職後沒多久便已經完成開發。

但如何快速的下載對賬單文件一直深深的困擾著我。

我早期的解決方案是用 Ahk（Autohotkey）開發一個模擬鍵盤滑鼠操作的文件來逐步點擊下載。

但這樣有幾個缺點。

1：網速不穩定，就會導致下載丟失文件。（為了彌補這個問題，我還寫了核對的宏）

2：耗時久，用這個程序下載數據要大概30-40分鐘。。。。

3：無法讓別人輕易做我的Backup，代碼轉給別人用需要進行不少網頁坐標的調試。（解析度不一樣，網頁顯示比例不一樣都會造成坐標設定的不一致）

----------------------------------------------

最近因為需要休長假出去玩，擔心團隊的Backup萬一遇到問題無法獨自解決。

所以希望短期內把這個過程找到一個簡單穩定高效的解決方案。

研究了一下vba能否進行」爬蟲「，發現閑魚有vba網抓的課程售賣，沒在乎價格就立刻下單買了。。。。

下載後是幾十集的視頻教學，講的是各種xml，http的相關知識，vba如何後台登錄，如何百度抓取數據，如何用數組和正則表達式對下載數據進行切割處理。

看了一個多星期。收益頗多。

先上這一周努力的結果，截圖如下

設計的時候，覺得數據還是比較多，所以增加了一個進度條。來讓使用者可以知道下載進度。但實際上寫完測試發現多此一舉，2分鐘怎麼也都能下完了。。。

但好容易做出來了，也懶得改回去了。。。

----------------------------------------------

講了太多廢話，進入正題

先看看

#公司銀行文件正常情況要如何下載#

銀行的數據是由銀石公司直接從銀行伺服器抓取，然後上傳到我們公司的內網伺服器。

所以銀行可能數據只保存半年，而我們則是一直保存著。

首先登錄公司的內網，輸入賬號密碼，還有驗證碼。

（研究如何破解驗證碼也花了不少功夫，以後有空把心得寫一寫）

進入後輸入需要下載的賬號，選擇日期，但無法批量下載，只能一個一個點擊下載。

一口氣選好幾天，就要點好幾天

並且下載後還不是txt文件的格式，而是文件名加日期的後綴

比如10455555556666.20160801

需要手工一個一個重命名修改成txt.

假如你需要手工修改100個文件的後綴名，你要如何做？

這個問題我是用批處理解決的。

建立一個txt文檔，輸入上圖的語句，另存為 .bat 文件，就可以批量修改同一個文件夾中的所有文件變為txt格式。

然後再用自己寫的Excel的宏讀取txt，將txt轉換成excel格式，與系統數據進行核對。

可見我沒來公司前，大家每天對賬是多麼麻煩。。。

----------------------------------------------

我們也曾經問過工程師，能否開發成一鍵下載所有的文件，但對方果斷的拒絕了。。

----------------------------------------------

呵呵，有時候只能靠自己。

----------------------------------------------

我發現因為數據是放在內網，實際上沒有做什麼防盜鏈的處理。

也就是知道下載地址，就可以直接下載。

我甚至省去了用cookie 進行繞過登錄的過程…………

而下載地址其實就是固定的前綴和賬號和日期的組合形成不同的變數而已。

先把100多個公司和對應的賬戶號複製到excel，並備註好城市。

在單元格F1 讓負責下載的員工手工輸入需要下載的日期。

用For Next循環完成下載

代碼和Sheet1 截圖如下

Sub DemoProgress1()Application.ScreenUpdating = False 關閉屏幕刷新 Application.DisplayAlerts = False 關閉提示 Dim strurl As StringThisWorkbook.Sheets("sheet1").Selectlastrow = ThisWorkbook.Sheets("Sheet1").[b65535].End(xlUp).Row 最後一行所在行數date1 = ThisWorkbook.Sheets("sheet1").Range("f1") 讀取需要下載的日期For i = 2 To lastrowstrurl = "http://10.200.28.2:8080/posp4-manager/posp/download.do?action=downloadFile&fileName=" & shopno & "." & date1 & ""內網數據所在地址Dim xmlhttp As ObjectSet xmlhttp = CreateObject("msxml2.xmlhttp") 後期綁定xmlhttp.Open "GET", strurl, Falsexmlhttp.sendDo While xmlhttp.readystate <> 4 等待完成 DoEventsLoopDim b() As Byteb = xmlhttp.responsebodyOpen ThisWorkbook.Path & "" & shopno & ".txt" For Binary As #1 Put #1, , b() CloseNext

按照自己想的運行了一下。報錯。

檢查了一下，發現是有些賬號實際上當時開通後從未使用過，所以後台是沒有任何數據可以下載的。故而報錯，無法進行下載。

於是加入一條驗證代碼，表中增加一列「是否有效」。（其實最簡單的方法就是直接刪掉那些無效的賬號即可）

If ThisWorkbook.Sheets("sheet1").Range("d" & i) = "Y" Thenshopno = ThisWorkbook.Sheets("sheet1").Range("b" & i)

目前代碼如下（未增加進度條版本）

Sub DemoProgress1()Application.ScreenUpdating = False 關閉屏幕刷新 Application.DisplayAlerts = False 關閉提示 Dim strurl As StringThisWorkbook.Sheets("sheet1").Selectlastrow = ThisWorkbook.Sheets("Sheet1").[b65535].End(xlUp).Row 最後一行所在行數date1 = ThisWorkbook.Sheets("sheet1").Range("f1") 讀取需要下載的日期For i = 2 To lastrowIf ThisWorkbook.Sheets("sheet1").Range("d" & i) = "Y" Thenshopno = ThisWorkbook.Sheets("sheet1").Range("b" & i)strurl = "http://10.200.28.2:8080/posp4-manager/posp/download.do?action=downloadFile&fileName=" & shopno & "." & date1 & ""內網數據所在地址Dim xmlhttp As ObjectSet xmlhttp = CreateObject("msxml2.xmlhttp") 後期綁定xmlhttp.Open "GET", strurl, Falsexmlhttp.sendDo While xmlhttp.readystate <> 4 等待完成 DoEventsLoopDim b() As Byteb = xmlhttp.responsebodyOpen ThisWorkbook.Path & "" & shopno & ".txt" For Binary As #1 Put #1, , b() CloseEnd IfNext

運行一下，大概花了1分鐘多點，效率提升40倍，哈哈。

這下可以淡定的去休假了。。。