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对象链接和嵌入相关模块 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
=======================================================================================