1

以下のマクロを使用してサーバーからファイルを正常にダウンロードできますが、ファイル名が正しくない場合があるため、ディレクトリを手動で調べて、ダウンロードされたものとダウンロードされるべきものを比較する必要があり、非常に時間がかかりました。ダウンロードされなかったもののログを提供するには、このマクロに何を含める必要がありますか?

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
4

1 に答える 1

3

これはあなたがしようとしていることですか？(未テスト)

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はファイルが利用できない場合でもファイルをダウンロードするため、これは必須です。この場合の唯一のことは、イメージ ファイルが破損することです。

これを処理する最善の方法は、ユーザー フォームを作成し、イメージ コントロールを追加することです。必要に応じて、イメージ コントロールの 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

于 2012-05-22T11:46:52.653 に答える