3

可能重复：
从 url 获取图片，然后重命名图片

我有超过 30 多个文件链接需要下载。有没有办法做到这一点？

我想在 excel 中做，因为要获得这 30 多个链接，我必须做一些我在 excel 中做的清理工作。

我每天都需要这样做。如果有办法在excel中做会很棒。

例如，如果 A2 是图像，则将此图像下载到文件夹中

https://www.google.com/images/srpr/logo3w.png

如果有办法将 logo3w.png 重命名为 B2 中的任何内容，那就更棒了，所以我不必重命名文件。

下面的脚本，我在网上找到的，它可以工作，但我需要帮助重命名它。
在 A2 列中：向下我有所有链接
在 B2 列中：向下我有带扩展名的文件名

常量 TargetFolder = "C:\Temp\"

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


Sub Test()
For Each Hyperlink In ActiveSheet.Hyperlinks
    For N = Len(Hyperlink.Address) To 1 Step -1
        If Mid(Hyperlink.Address, N, 1) <> "/" Then
            LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
        Else
            Exit For
        End If
    Next N
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
Next Hyperlink
End Sub


Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub
4

2 回答 2

1

我很确定您可以稍微修改以下代码以满足您的需求：

Sub DownloadCSV()

Dim myURL As String
myURL = "http://pic.dhe.ibm.com/infocenter/tivihelp/v41r1/topic/com.ibm.ismsaas.doc/reference/LicenseImportSample.csv"

Dim WinHTTPReq As Object
Set WinHTTPReq = CreateObject("Microsoft.XMLHTTP")
Call WinHTTPReq.Open("GET", myURL, False)
WinHTTPReq.send

If WinHTTPReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHTTPReq.responseBody
    oStream.SaveToFile ("D:\DOCUMENTS\timelog.csv")
    oStream.Close
End If

End Sub

祝你好运！

于 2013-02-03T19:07:24.670 回答
0

这应该适合你。它将下载并使用 B 列中的文件名重命名。我只是用一行替换了第二个 for 循环。Hyperlink.range.row 给出超链接所在的行号。所以 cells(hyperlink.range.row,2) 计算结果为 cells(1,2)、cells(2,2) 等等（如果数据在 A1、A2、A3 中）。假设您在 B 列中有扩展名（ex - xyz.png）的文件名，这应该可以工作。

Const TargetFolder = "C:\Temp\"
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


Sub Test()
   For Each Hyperlink In ActiveSheet.Hyperlinks
       LocalFileName=ActiveSheet.cells(hyperlink.Range.Row,2).value
       Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
   Next Hyperlink
End Sub


Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
   Dim Res As Long
   On Error Resume Next
   Kill LocalFileName
   On Error GoTo 0
   Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub

让我知道这是否有帮助。

于 2013-02-04T06:50:41.823 回答