使用vba在excel中记录下载的文件

Question

我可以使用下面的宏从服务器成功下载文件，但有时文件名可能不正确，因此我必须手动浏览目录并比较下载的内容与应该下载的内容相比非常耗费时间。我需要在此宏中包含哪些内容，以便提供未下载内容的日志？

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 imagedownloader()
    Dim i As Long, url As String
    With ActiveWorkbook.Sheets("Sheet1") 'must use the name of the sheet to do this
    For i = 1 To 4 'Where 4 is the number of items in the list (can be made dynamic)
        DoEvents
        url = "http://mydomain.com/images/" & .Range("A" & i).Value & ".jpg"
        URLDownloadToFile 0, url, "C:\downloads\images\" & .Range("A" & i).Value & ".jpg", 0, 0
    Next
    End With
End Sub

Answer 1

这是你在尝试什么？ （的 UNTESTED ）

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

Sub imagedownloader()
    Dim i As Long
    Dim filesize As Integer
    Dim FlName As String, url As String

    FlName = "C:\downloads\images\Log.Txt"

    '~~> get a free file handle
    filesize = FreeFile()

    '~~> Open your file
    Open FlName For Output As #filesize

    With ActiveWorkbook.Sheets("Sheet1")
        For i = 1 To 4
            url = "http://mydomain.com/images/" & .Range("A" & i).Value & ".jpg"

            URLDownloadToFile 0, url, "C:\downloads\images\" & .Range("A" & i).Value & ".jpg", 0, 0

            DoEvents

            If DoesFileExist("C:\downloads\images\" & .Range("A" & i).Value & ".jpg") Then
                Print #filesize, .Range("A" & i).Value & ".jpg - Successfully Downloaded"
            Else
                Print #filesize, .Range("A" & i).Value & ".jpg - Not Downloaded"
            End If
        Next
    End With

    Close #filesize
End Sub

Public Function DoesFileExist(FilePath As String) As Boolean
    On Error GoTo Whoa
    If Not Dir(FilePath, vbDirectory) = vbNullString Then DoesFileExist = True
Whoa:
    On Error GoTo 0
End Function

<强>后续

这是一个高级版本（ TESTED AND TRIED ）。这是必需的，因为URLDownloadToFile即使文件不可用也会下载文件。在这种情况下唯一的事情是图像文件会损坏。

处理此问题的最佳方法是创建用户表单并添加图像控件。如果需要，可以将图像控件的visible属性设置为false。现在使用此代码。我已经对它进行了评论，因此您在理解它时没有任何问题：）

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

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim filesize As Integer
    Dim FlName As String, url As String

    FlName = "C:\downloads\images\Log.Txt"

    '~~> Get a free file handle
    filesize = FreeFile()

    '~~> Open your file
    Open FlName For Output As #filesize

    With ActiveWorkbook.Sheets("Sheet1")
        For i = 1 To 4
            url = "http://capnhud.host22.com/examples/" & .Range("A" & i).Value & ".jpg"

            URLDownloadToFile 0, url, "C:\downloads\images\" & .Range("A" & i).Value & ".jpg", 0, 0

            DoEvents

            '~~> Try to load the downloaded image to Image1 Control
            On Error Resume Next
            Set Image1.Picture = LoadPicture("C:\downloads\images\" & .Range("A" & i).Value & ".jpg")
            '~~> If image is not in the correct format then delete it
            If Not Err.Number = 0 Then
                Kill "C:\downloads\images\" & .Range("A" & i).Value & ".jpg"
                Print #filesize, .Range("A" & i).Value & ".jpg - Not Downloaded"
            Else
                Print #filesize, .Range("A" & i).Value & ".jpg - Successfully Downloaded"
            End If
        Next
    End With

    Close #filesize
End Sub

<强>快照

注意：您现在实际上不需要DoesFileExist功能。您也可以在If Not Err.Number = 0 Then中写入文本。

样本文件

http://wikisend.com/download/310908/Sample.xlsm

HTH