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

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