vba - 使用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

这是你正在尝试的吗？ ( 未测试 )

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

跟进
这是一个高级版本( 已测试和试用 )。这是必需的，因为 URLDownloadToFile即使文件不可用，也会下载文件。在这种情况下，唯一的事情就是图像文件会损坏。
处理这个问题的最好方法是创建一个用户窗体并添加一个图像控件。如果需要，可以将图像控件的可见属性设置为 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
高温高压