vba下载（vba下载图片）

钉钉是个非常不错的工具，在我们日常使用中经常要上传一些图片，有的是为了打卡，有的为了审批流程，实际使用中都有照片的上传，但是将有照片的数据导出时，其在Excel中是显示该图片的一个链接，如果上传的是多张照片则是一组照片链接，如果我们想保存其中的照片或者是查看，会很不方便。如图所示：

钉钉中下载的示例数据

今天我就结合Excel中导出的数据，结合VBA，将钉钉中导出的数据中的图片全部下载到本地。具体代码如下：

Sub 下载钉钉导出数据中的图片()Dim i As IntegerDim sFileName, sUrl As StringDim arr() As StringDim arrCol() As StringOn Error Resume NextDim sKey, sDownS, sDown As StringDim iLine As IntegersKey = InputBox(“请输入需要建目录的关键列号（请输入列号的字母）”)sDownS = InputBox(“请输入需要下载图片的列号（输入多个要下载的列号的字母，如果多列请用半角分号分隔开）”)iLine = Int(InputBox(“请输入您指定开始下载的行号（只能输入数字）”))If iLine <= 2 Then iLine = 2Dim PathSht As StringWith Application.FileDialog(msoFileDialogFolderPicker) If .Show Then PathSht = .SelectedItems(1) Else Exit Sub '如果没有选择路径则退出End WithPathSht = PathSht & ""For i = iLine To Range("A" & Rows.Count).End(xlUp).Row MkDir (PathSht & Range(sKey & i)) '建立一个文件夹 Dim m As Integer arrCol = Split(sDownS, ";") '判断是不是有多列需要下载 For m = 0 To UBound(arrCol) sDown = arrCol(m) Dim j As Integer arr = Split(Range(sDown & i), Chr(10)) '钉钉中特有的，如果有多张图片，钉钉中会使用分割符分割 Dim jj As Integer jj = 0 For j = 0 To UBound(arr) If arr(j) "" Then jj = jj 1 sFileName = PathSht & Range(sKey & i) & "" & Range(sDown & 1) & jj & ".jpg" '将所在列标题作为文件名 sUrl = arr(j) If sUrl "" Then Call HttpDownNetFile(sFileName, sUrl) '如果内容不为空，则开始下载照片 End If Next NextNextMsgBox "全部下载完成"End Sub

Sub HttpDownNetFile(ByVal sFileName As String, ByVal sUrl As String)On Error Resume NextIf sFileName = “” Then Exit SubIf sUrl = “” Then Exit SubDim XmlHttp As ObjectDim ayrHttpBody() As ByteSet XmlHttp = CreateObject(“Microsoft.XMLHTTP”)XmlHttp.Open “GET”, sUrl, TrueXmlHttp.sendDo Until XmlHttp.readyState = 4 DoEventsLoopIf XmlHttp.Status = 200 Then ayrHttpBody() = XmlHttp.responseBody Open sFileName For Binary As #1 Put #1, , ayrHttpBody() Close #1 Set XmlHttp = NothingEnd IfEnd Sub

在Excel中VBA环境下调用该代码，分别弹出三个对话框，其功能分别如下：