從URL下載圖像並重命名

我有一個包含2列A和B的Excel工作表。列A有一個名稱，列B有圖像URL。從URL下載圖像並重命名

我想下載所有的圖像，並將它們重新命名爲列A中的內容。我在這裏搜索過，看起來有一個以前的解決方案，但代碼不適用於我的Excel版本/ PC，因爲我得到一個錯誤：

「編譯錯誤

在項目中的代碼必須在64個系統，請查看並更新Declare語句然後用PTRSAFE屬性將它們標記的使用進行更新。」

下面是以前的帖子：GET pictures from a url and then rename the picture

將不勝感激和熱愛這方面的任何幫助！

來源

2017-02-12 Kelvin Chua

@Amorpheuses：取代你。「64位機器安裝的辦公室的最新版本」與「安裝了最新的32位版本的64位機器」。 –

等一下，我有可能爲我的Windows版本安裝了錯誤的office版本嗎？ –

我不會將64位Office版本稱爲64位Windows系統的錯誤版本。但明確使用'Declare'語句它不同於32位版本。請參閱[32位和64位版本Office之間的兼容性]（https://msdn.microsoft.com/zh-cn/library/office/ee691831（v = office.14）.aspx）。 @Amorpheuses曾表示，它適用於使用64位Windows的他。但是，如果他在64位Windows上運行32位Office，那隻能是這樣。 –

以下Sub應與GET pictures from a url and then rename the picture中的相同。但由於它不使用系統功能，而只使用本地Excel VBA，因此它應該與是否使用32位或64位Office無關。

的Sheet1：

代碼：

Const FolderName As String = "P:\Test\" 

Sub downloadJPGImages() 

Set ws = ActiveWorkbook.Sheets("Sheet1") 
lLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row 

Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0") 
Set oBinaryStream = CreateObject("ADODB.Stream") 
adTypeBinary = 1 
oBinaryStream.Type = adTypeBinary 

For i = 2 To lLastRow 
    sPath = FolderName & ws.Range("A" & i).Value & ".jpg" 
    sURI = ws.Range("B" & i).Value 

    On Error GoTo HTTPError 
    oXMLHTTP.Open "GET", sURI, False 
    oXMLHTTP.Send 
    aBytes = oXMLHTTP.responsebody 
    On Error GoTo 0 

    oBinaryStream.Open 
    oBinaryStream.Write aBytes 
    adSaveCreateOverWrite = 2 
    oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite 
    oBinaryStream.Close 

    ws.Range("C" & i).Value = "File successfully downloaded as JPG" 

NextRow: 
Next 

Exit Sub 

HTTPError: 
ws.Range("C" & i).Value = "Unable to download the file" 
Resume NextRow 

End Sub

來源

2017-02-15 08:23:22

從URL下載圖像並重命名

回答

相關問題