使用单元格数据将图像从网站拉到Excel中作为URL的一部分

时间:2014-03-25 13:20:12

标签: excel

我的网站上有许多图书封面图片,这些图片与其图书编号和印刷格式(硬封面,平装本等)相匹配。使用Excel中的两个值,是否可以自动从我的网站提取图像?

A1中的Cell值是ABC123,B1中的单元格值是平装本。我希望使用以下内容在C1中显示图像:http://www.example.com/images/ABC123_paperback.jpg

呼叫需要针对多个小区,所以A1 + B1,A2 + B2,A3 + B3。

我对Excel没有任何经验,所以我甚至无法启动所需的公式/ VB!但任何参考点开始将不胜感激。

1 个答案:

答案 0 :(得分:0)

一些示例VBA代码,可帮助您开始在Excel中下载文件。

Private Function SaveTo(mURL As String, mDest As String)
    Dim i As Long
    Dim FileNum As Long
    Dim FileData() As Byte
    Dim Error, Username As String
    Dim WHTTP As Object
    Username = Environ$("Username")

    On Error Resume Next
    Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
    If Err.Number <> 0 Then
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
    End If
    On Error GoTo 0
    FileNum = FreeFile
    WHTTP.Open "GET", mURL, False
    WHTTP.SetAutoLogonPolicy (0)
    i = WHTTP.SetTimeouts(2000, 60000, 300000, 300000)
    WHTTP.Send

    If (WHTTP.Status <> 200) Then
        mDest = mDest + "-Error.html"
        Error = Error + "Error " & WHTTP.Status & ":" + Chr(13) + Chr(10)
        Error = Error + WHTTP.GetAllResponseHeaders()
        Error = Error + "<b>" + WHTTP.StatusText + "</b>"
        Error = Error + Chr(13) + Chr(10) + "URL: <a href=""" + mURL + """>" + mURL + "</a>"
        Error = Error + Chr(13) + Chr(10) + "Check parameters specified are correct."
        Error = Replace(Error, Chr(13) + Chr(10), "<br/>")
        If (Len(WHTTP.ResponseText) > 0) Then Error = Error + Chr(13) + Chr(10) + WHTTP.ResponseText

        FileData = Error
    Else
        ' We got the file!
        ' Check to see if we had an error downloading last time, and delete the error file
        If (Dir(mDest + "-Error.html") <> "") Then Kill mDest + "-Error.html"

        FileData = WHTTP.ResponseBody

    End If

    FileNum = FreeFile
    Open mDest For Binary Access Write As #FileNum
    Put #FileNum, 1, FileData
    Close #FileNum
    'Debug: Halt on download failure to check syntaxes
    'If (WHTTP.Status <> "200") Then
    '    i = MsgBox("Download Failed! Error: " & WHTTP.Status, vbCritical)
    'End If

    Set WHTTP = Nothing
End Function