特集記事

VBAでファイルをダウンロードする

Windows APIを使ってWebからファイルをダウンロードする

2008/02/26 14:00

ポスト

まとめてファイルへ書き込む

　前ページの例では1024バイトごとにデータをダウンロードしファイルへ書き込んでいますが、ファイルへの書き込み回数が多いため非効率的です。ダウンロードしたデータをまとめて1度でファイルへ書き込む方法を紹介します。

　配列の先頭要素を「参照渡し」で渡すと配列全体のメモリアドレスを渡すことになると先ほど書きましたが、同様に、配列の途中の要素を「参照渡し」で渡すと、その要素のメモリアドレスが関数に渡されます。

　例えば、「Dim a(1 To 100) As Byte」と宣言された長さ100の配列aがある場合、a(51)を「参照渡し」で渡すと配列aの51バイト目のメモリアドレスを関数は受け取ります。これを利用して、ダウンロードしたデータをまとめて1度にファイルへ書き込むプログラムを作成します。

　なお、Declareステートメントは前項の例と同じなので割愛します。

動的配列を使ったサンプル2

Sub バナーのダウンロード2()
    'バナー画像のURL
    Const URL = "http://codezine.jp/img/banner/forlink/lbanner_l.gif"
    
    Dim s As String
    Dim FileName As String
    Dim FileNumber As Integer
    Dim hOpen As Long
    Dim hConnect As Long
    Dim buf() As Byte '動的配列
    Dim dwSize As Long
    Dim total As Long 'ダウンロード済みのデータのサイズ

    'WinInetを初期化
    hOpen = InternetOpen("Excel VBA", INTERNET_OPEN_TYPE_DIRECT, _
                         vbNullString, vbNullString, 0)

    'URLを開く
    hConnect = InternetOpenUrl(hOpen, URL, vbNullString, 0, _
                               INTERNET_FLAG_RELOAD, 0)

    total = 0
    ReDim buf(1 To 1000000) '十分な大きさの配列のサイズを確保する

    Do
        '1024バイトずつデータを取得する
        
        '配列のダウンロード済みのデータの次の要素を渡す
        InternetReadFile hConnect, buf(total + 1), 1024, dwSize
  
        'データ取得サイズが0になったら終了
        If dwSize = 0 Then
            Exit Do
        Else
            'ダウンロード済みのデータのサイズを計算していく
            total = total + dwSize
        End If
    Loop

    'ハンドルを開放
    InternetCloseHandle hConnect
    InternetCloseHandle hOpen
            
    '動的配列の大きさを再定義
    'Preserve を指定してデータが消えないようにする
    ReDim Preserve buf(1 To total)
    
    '保存する.gifファイルのパスを取得
    'マクロ含むExcelファイルと同じフォルダに保存する
    s = ThisWorkbook.FullName
    FileName = Left(s, InStrRev(s, "\", , vbBinaryCompare)) & _
               "banner2.gif"
    
    '保存用にファイルを開く
    FileNumber = FreeFile
    Open FileName For Binary Access Write As #FileNumber
    
    'ファイルへ書き込み
    Put #FileNumber, , buf
    
    'ファイルを閉じる
    Close #FileNumber

    '配列を消去
    Erase buf
End Sub