3

重複の可能性:
URLから画像を取得してから画像の名前を変更します

ダウンロードする必要のあるファイルリンクが30以上あります。これを優れたものにする方法はありますか?

30以上のリンクを取得するには、Excelで行うクリーンアップを実行する必要があるため、Excelで実行したいと思います。

私はこれを毎日行う必要があります。エクセルで行う方法があれば素晴らしいでしょう。

たとえば、A2が画像の場合、この画像をフォルダにダウンロードします

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

logo3w.pngの名前をB2にあるものに変更する方法があれば、それはさらに素晴らしいので、ファイルの名前を変更する必要はありません。

以下のスクリプト、私はオンラインで見つけました、それは動作しますが、名前を変更するのに助けが必要です。
列A2:downにすべてのリンクがあります
列B2:downに拡張子が付いたファイル名があります

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
    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にあるファイル名に名前を変更します。2番目のforループを行に置き換えました。Hyperlink.range.rowは、ハイパーリンクが存在する行番号を示します。したがって、cells(hyperlink.range.row、2)はcells(1,2)、cells(2,2)などに評価されます(データがA1、A2、A3にある場合)。列Bに拡張子(例: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 に答える