运行Vba代码时出错

时间:2017-04-08 09:58:56

标签: vba

#If Win64 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" _
    (ByRef pCaller As LongPtr, _
     ByVal szURL As String, _
     ByVal szFileName As String, _
     ByVal dwReserve As Long, _
     ByRef lpfnCB As LongPtr) _
As LongPtr
#Else
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" _
    (ByRef pCaller As Long, _
     ByVal szURL As String, _
     ByVal szFileName As String, _
     ByVal dwReserve As Long, _
     ByRef lpfnCB As Long) _
As Long
#End If

Dim Ret As Long

'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Temp"

Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String

'~~> Name of the sheet which has the list
Set ws = Sheets("Sheet1")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow '<~~ 2 because row 1 has headers
strPath = FolderName & ws.Range("A" & i).Value & ".jpg"

Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)

If Ret = 0 Then
ws.Range("C" & i).Value = "File successfully downloaded"
Else
ws.Range("C" & i).Value = "Unable to download the file"
End If
Next i
EndSub

enter image description here 错误如下:

2 个答案:

答案 0 :(得分:0)

在更正API函数中的参数后,这就是我使用的。

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


Const FolderName As String = "C:\Temp\"

Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String

Set ws = Sheets("Sheet1")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow '<~~ 2 because row 1 has headers
    strPath = FolderName & ws.Range("A" & i).Value & ".jpg"
    Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
    If Ret = 0 Then
        ws.Range("C" & i).Value = "File successfully downloaded"
    Else
        ws.Range("C" & i).Value = "Unable to download the file"
    End If
Next i
End Sub

要在下载成功时获取文件路径,请尝试使用。 因此,如果文件成功下载,路径将被放置在列C中,并且msg“文件成功下载”在列D中,否则列C将包含“无法下载文件”。

For i = 2 To LastRow '<~~ 2 because row 1 has headers
    strPath = FolderName & ws.Range("A" & i).Value & ".jpg"
    Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
    If Ret = 0 Then
        ws.Range("C" & i).Value = strPath
        ws.Range("D" & i).Value = "File successfully downloaded"
    Else
        ws.Range("C" & i).Value = "Unable to download the file"
    End If
Next i

答案 1 :(得分:0)

这对我有用。欲了解更多信息,请查看here

Option Explicit

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

Const FolderName As String = "C:\Temp"

Sub Sample()
    Dim Ret As Long
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String
    Dim urlFileName As String

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

    For i = 2 To LastRow
        strPath = FolderName & "\" & ws.Range("A" & i).Value & ".jpg"
        urlFileName = ws.Range("B" & i).Value
        Ret = URLDownloadToFile(0, urlFileName, strPath, 0, 0)

        If Ret = 0 Then
            ws.Range("C" & i).Value = "File successfully downloaded"
        Else
            ws.Range("C" & i).Value = "Unable to download the file"
        End If
    Next i
End Sub
  

工作表上的数据

HeaderA    |   HeaderB
SomeImage1 |   http://www.someaddress.com/Imgs/SomeImage1.jpg