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

Question

此 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

一种方法是从响应中解析Content-Type：

Sub DownloadLink()

  Const imageLink = "http://i.stack.imgur.com/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