VBA下載文件三種方法

 下面提供三種方式下載遠程文件，

Sub test()
    Dim H, S
    Set H = CreateObject("Microsoft.XMLHTTP")
    H.Open "GET", http://www.163.com/test.exe, False   '文件網址
    H.send   
    Set S = CreateObject("ADODB.Stream")
    S.Type = 1 '二進制
    S.Open
    S.write H.Responsebody '寫入取得的內容
    S.savetofile "c:\temp\test.exe", 2  '保存文檔
    S.Close
End Sub

Sub test2()
Dim bt() as byte '建立數組
Dim H As Object
    Set H = CreateObject("Microsoft.XMLHTTP")
    H.Open "GET", "Http://www.163.com/test.exe", False
    H.send
    If H.Status = 200 Then '沒有超時
        bt = H.Responsebody
        Open "http://www.163.com\test.exe" For Binary As #1 '建立二進制文件，這里的路徑可以是本地文件
        Put 1, , bt '寫入文件
        Close #1
    End If
End Sub 


Private Declare Function URLDownloadToFile Lib "urlmon" Alias"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
　　　　ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long'申明API

Sub downlaod()
    URLDownloadToFile 0, "http://www.163.com/test.exe", "c:\temp\ver.exe", 0, 0
End Sub

 

 

出處: http://www.bianzhirensheng.com/view/18631.html

=======================================================================================

通過VBA下載遠程文件的方法

　　VB語言雖然已經逐漸沒落，已經沒有多少人在使用他了，但是如果和Excel結合起來，將毫無疑問的大大提升我們的工作效率，只是很多時候並未引起足夠的重視，或者說很少有人知道，其實它可以完成你幾乎能想得到的所有功能，更重要的是它是一種所見即所得的語言，無需編譯，無需部署更不用進行一些列的發布等重操作。

　　當然了，這依賴於對數據分析與統計的實際需要，也依賴於對excel高階運用的深刻理解，如果只是把excel作為單純的數據編輯等簡單的應用，那么VBA的使用無論如何也是沒有場景的。

　　近期我把實際工作中用到的一些共通的方法梳理出來，目的是希望大家能夠也運用的自己的工作中，即使用不到，至少也知道它能干什么，這或許能為你未來的工作拓寬一下思路。

　　今天主要說的是一個遠程下載的方法，可以通過一個遠程下載的路徑，將遠程文件下載到本地，並重命名。只需把遠程下路徑和重命名作為入參傳給主函數即可。

　　提前祝各位聖誕節快樂！！

 

'依賴urlmon.dll：微軟Microsoft對象鏈接和嵌入相關<a target="_blank" href="http://www.imitker.com/tags-614.html" style="color:#000000">模塊</a>
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long _
    ) As Long

'******************************************
'*功能：遠程文件下載主函數
'******************************************
Public Function downloadTolocal(ByVal Down_link As String, ByVal FileName As String)
    If downloadFile(Down_link, FileName) = True Then
        MsgBox "Download Successfully"
    Else
        MsgBox "Download Failed"
    End If

End Function

'******************************************
'*功能：文件下載到本地並重命名
'*參數：遠程下載路徑；重命名文件名
'*返回值：下載成功或者失敗
'******************************************
Public Function downloadFile(ByVal strURL As String, ByVal strFile As String) As Boolean
    application.EnableCancelKey = xlDisabled
    Dim lngReturn    '用lngReturn接收返回的結果
    lngReturn = URLDownloadToFile(0, strURL, strFile, 0, 0)    '注意：URLDownloadToFile函數返回0表示文件下載成功

    '判斷返回的結果是否為0,則返回True，否則返回False
    If lngReturn = 0 Then
        downloadFile = True
    Else
        downloadFile = False
    End If
End Function

 

出處：http://www.imitker.com/post/508.html

=======================================================================================

vbs使用URLDownloadToFile下載文件

以下代碼的功能是從百度下載圖片到C盤中，名為123.jpg

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub 從百度下載圖片到C盤()
    Dim xmlhttp, ayrHttpBody() As Byte
    Set xmlhttp = CreateObject("microsoft.xmlhttp")
    With xmlhttp
        .Open "GET", "https://ss1.baidu.com/9vo3dSag_xI4khGko9WTAnF6hhy/image/h%3D300/sign=8c56d4a6d8c8a786a12a4c0e5708c9c7/5bafa40f4bfbfbed022d422371f0f736afc31f71.jpg", False    '設定訪問下載文件
        .send
    End With
    ayrHttpBody() = xmlhttp.Responsebody
    Open "c:\123.jpg" For Binary As #1
    Put #1, , ayrHttpBody()
    Close #1
End Sub

 

出處：https://club.excelhome.net/thread-1325026-1-1.html

=======================================================================================

使用VBS批量下載文件

Sub DemoProgress1()
Application.ScreenUpdating = False '關閉屏幕刷新
 Application.DisplayAlerts = False '關閉提示
  
Dim strurl As String

ThisWorkbook.Sheets("sheet1").Select
lastrow = ThisWorkbook.Sheets("Sheet1").[b65535].End(xlUp).Row '最后一行所在行數
date1 = ThisWorkbook.Sheets("sheet1").Range("f1") '讀取需要下載的日期

For i = 2 To lastrow

If ThisWorkbook.Sheets("sheet1").Range("d" & i) = "Y" Then
shopno = 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 Object
Set xmlhttp = CreateObject("msxml2.xmlhttp") '后期綁定

xmlhttp.Open "GET", strurl, False
xmlhttp.send

Do While xmlhttp.readystate <> 4 '等待完成
 DoEvents
Loop

Dim b() As Byte
b = xmlhttp.responsebody
Open ThisWorkbook.Path & "\" & shopno & ".txt" For Binary As #1
   Put #1, , b() 
Close
End If
Next

 

出處：https://zhuanlan.zhihu.com/p/21899544

=======================================================================================