从 URL 插入图像

Question

以下代码适用于大多数图像 URL，但对于此特定 URL，我收到错误：

Sub test()
Sheets(1).Shapes.AddPicture "https://images-na.ssl-images-amazon.com/images/M/MV5BYzVlY2JiODctNGMzNC00OWE5LTg3MTEtNDQ3NDYxNjIxNTBiXkEyXkFqcGdeQXVyNTM3MDMyMDQ@._V1_.jpg" _
                          , msoFalse, msoTrue, 100, 100, 500, 600
End Sub

运行时错误“1004”：找不到指定的文件

是否是这个特定URL字符串的指定方式导致的（与VBA不兼容）？或者您认为这与主机阻止访问有关？谢谢。

Answer 1

尝试寻找

*.png

图片。然后就可以了。

我尝试过来自巴布亚新几内亚同一亚马逊网站的一个 -

Sub Test()

     Sheets(1).Shapes.AddPicture _
                 "https://images-na.ssl-images-amazon.com/images/I/31TN1u5GEqL.png",  _
                 msoFalse, msoTrue, 100, 100, 500, 600
End Sub

在 MSDN 中，他们给出了

*.bmp

文件的示例。

编辑： 然而，

*.jpg

可以在许多其他网站上使用。因此亚马逊可能正在限制它。

Answer 2

添加另一个“修复”，因为接受的答案并未完全解决问题。

问题似乎出在 Excel 请求图像所使用的特定机制上：您可以通过单独下载到临时文件并从那里插入图像来解决该问题。

Sub URLPictureInsert()
    Dim theShape As Shape, rng As Range, cell As Range, Filename As String
    Dim tempPath As String
    
    'On Error Resume Next
    'Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("A2:A10")
    For Each cell In rng
        Filename = cell.Value
        If Len(Filename) < 5 Then GoTo skip
        
        'download the file to the temp folder and return the path
        tempPath = DownLoadedImagePath(Filename)
        
        Set theShape = ActiveSheet.Shapes.AddPicture( _
            Filename:=tempPath, linktofile:=msoFalse, _
            savewithdocument:=msoCTrue, _
            Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
        
        With theShape
            .LockAspectRatio = msoTrue
            .Top = cell.Top + 1
            .Left = cell.Left + 1
            .Height = cell.Height - 2
            '.Width = cell.Width - 2
            .Placement = xlMoveAndSize
        End With
        ' Get rid of the
        'cell.ClearContents
'isnill:
        'Set theShape = Nothing
        'Range("A2").Select

skip:
    Next
    Application.ScreenUpdating = True

    Debug.Print "Done " & Now

End Sub

'download content from `url` to a temp file and return the temp file path
Function DownLoadedImagePath(url As String) As String
    Dim Data() As Byte, tempPath As String, fNum As Long
    With CreateObject("WinHTTP.WinHTTPrequest.5.1")
        .Open "GET", url, False
        .send
        Data = .responseBody
    End With
    fNum = FreeFile
    tempPath = getTempPath()
    Open tempPath For Binary Access Write As #fNum
    Put #fNum, 1, Data
    Close #fNum
    DownLoadedImagePath = tempPath
End Function

'return a temporary file path
Function getTempPath() As String
    With CreateObject("scripting.filesystemobject")
        getTempPath = .GetSpecialFolder(2) & "\" & .GetTempName
    End With
End Function