「VBA ファイル ダウンロード」といったキーワード検索でのアクセスがありました。

Office系のQ&Aサイトを見ても「VBAでインターネット上のファイルをダウンロードしたい」という要望は多いようなので、色々な方法をまとめてみることにしました。

注意点

• 当記事は元々2014年に公開したものですが、一部冗長な処理があったので、2019年2月に改めて書き直すことにしました。
• 当記事に掲載しているコードは、Windows 10 Pro バージョン 1809 64ビット版＋Office 365 ProPlus バージョン 1903 32ビット版、Windows 7 Professional 64ビット版＋Office 2013 32ビット版で動作確認を行いました。
• 環境によってはコードが上手く動作しない可能性がありますので、その点はご注意ください。

目次

1. URLDownloadToFileを使ってファイルをダウンロードする方法
2. XMLHTTPRequest + ADODB.Streamを使ってファイルをダウンロードする方法
3. Basic認証によるアクセス制限がかかったサイトのファイルをダウンロードする方法
4. フォーム認証によるアクセス制限がかかったサイトのファイルをダウンロードする方法
5. 通知バー/Internet Explorerダイアログを操作してファイルをダウンロードする方法

---

URLDownloadToFileを使ってファイルをダウンロードする方法

インターネット上でよく見かけるのがこの方法、API関数の「URLDownloadToFile」を使ってファイルをダウンロードする方法です。

Option Explicit
 
'※ 64ビット版Officeアプリケーションの場合は要修正
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryW" ( _
        ByVal lpszUrlName As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileW" ( _
        ByVal pCaller As Long, _
        ByVal szURL As Long, _
        ByVal szFileName As Long, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long
 
Public Sub Sample01()
  DownloadFile "https://www.ka-net.org/images/logo.jpg", _
               "C:\Test\Sample_001.jpg"
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub
 
Private Sub DownloadFile(ByVal Url As String, ByVal SaveFilePath As String)
'URLDownloadToFileでファイルをダウンロード
'http://msdn.microsoft.com/en-us/library/aa383983.aspx
'http://msdn.microsoft.com/en-us/library/ms775123.aspx
'http://www.ken3.org/vba/backno/vba120.html 参考
  Dim ret As Long
  
  ret = 0 '初期化
  DeleteUrlCacheEntry StrPtr(Url) 'キャッシュクリア
  ret = URLDownloadToFile(0, StrPtr(Url), StrPtr(SaveFilePath), 0, 0)
  If ret <> 0 Then MsgBox "処理が失敗しました。", vbCritical + vbSystemModal
End Sub

DeleteUrlCacheEntry関数でキャッシュを削除した後、URLDownloadToFile関数で指定したファイルを指定した場所に保存するという、シンプルなものですね。説明も要らないくらいです。

ダウンロードしたいファイルのURLが分かっている場合には、この方法を使うのが簡単です。
ただし、64ビット版Officeアプリケーションで上記のコードを動かす際には、APIの宣言部分を64ビット用に修正する必要があります。

XMLHTTPRequest + ADODB.Streamを使ってファイルをダウンロードする方法

次はXMLHTTPRequestとADODB.Streamを使ってファイルをダウンロードする方法の紹介です。

Option Explicit

Public Sub Sample02()
  DownloadFile "https://www.ka-net.org/images/logo.jpg", _
               "C:\Test\Sample_002.jpg"
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub
 
Private Sub DownloadFile(ByVal Url As String, ByVal SaveFilePath As String)
'XMLHTTPRequest + ADODB.Streamでファイルをダウンロード
  Dim req As Object
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  Set req = CreateObject("Msxml2.XMLHTTP")
  req.Open "GET", Url, False
  
  'キャッシュ対策
  'http://vird2002.s8.xrea.com/javascript/XMLHttpRequest.html#XMLHttpRequest_Cache-Control
  'http://www.atmarkit.co.jp/ait/articles/0305/10/news002.html 参考
  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
  
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード：" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select
End Sub

大雑把に言えば、XMLHTTPRequestを使って指定したURLにリクエストを投げ、受け取ったバイナリ形式のレスポンスをADODB.Streamでローカルに保存する、というやり方です。

XMLHTTPRequestで上手くいかない場合は、下記のようにWinHttpRequestを使用してください。

Private Sub DownloadFile(ByVal Url As String, ByVal SaveFilePath As String)
'WinHttpRequest + ADODB.Streamでファイルをダウンロード
  Dim req As Object
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
  req.Open "GET", Url, False
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード：" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select
End Sub

Basic認証によるアクセス制限がかかったサイトのファイルをダウンロードする方法

次はBasic認証によるアクセス制限がかかったサイトのファイルをダウンロードする方法の紹介です。

会員制のサイト等を開こうとしたとき、下図のようにユーザー名とパスワードの入力を求められた経験のある人も多いだろうと思いますが、このタイプの認証で多いのがBasic認証です。

Option Explicit
 
Public Sub Sample03()
  DownloadFileBasicAuth "http://www.chama.ne.jp/htaccess_sample/index.htm", _
                        "C:\Test\BasicAuth.html", _
                        "chama", _
                        "1111"
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub
 
Private Sub DownloadFileBasicAuth(ByVal Url As String, _
                                  ByVal SaveFilePath As String, _
                                  ByVal UserName As String, _
                                  ByVal PassWord As String)
'XMLHTTPRequest + ADODB.Streamでファイルをダウンロード
'http://ja.wikipedia.org/wiki/Basic%E8%AA%8D%E8%A8%BC 参考
  Dim req As Object
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  Set req = CreateObject("Msxml2.XMLHTTP")
  req.Open "GET", Url, False
  
  'Authorizationヘッダーでユーザー名とパスワード送信
  req.setRequestHeader "Authorization", "Basic " & EncodeBase64Str(UserName & ":" & PassWord)
  
  'キャッシュ対策
  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
  
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード：" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select
End Sub
 
Private Function EncodeBase64Str(ByVal str As String) As String
'文字列をBase64エンコード
  Dim ret As String
  Dim d() As Byte
  Const adTypeBinary = 1
  Const adTypeText = 2
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("ADODB.Stream")
    .Open
    .Type = adTypeText
    .Charset = "UTF-8"
    .WriteText str
    .Position = 0
    .Type = adTypeBinary
    .Position = 3
    d = .Read()
    .Close
  End With
  With CreateObject("MSXML2.DOMDocument").createElement("base64")
    .DataType = "bin.base64"
    .nodeTypedValue = d
    ret = .Text
  End With
  On Error GoTo 0
  EncodeBase64Str = ret
End Function

仕組みとしては、Authorizationヘッダーでユーザー名とパスワードを付けてリクエストを投げ、認証に成功したらファイルをダウンロードする、というやり方です。

Wikipediaの記事にも書いてある通り、Basic認証ではユーザー名とパスワードをBase64エンコードする必要があるため、そのための関数「EncodeBase64Str」を用意しています。

フォーム認証によるアクセス制限がかかったサイトのファイルをダウンロードする方法

次は、下図のようにWebページ上でユーザー名やパスワードを入力してログインするのが必要なサイト(フォーム認証とします)からファイルをダウンロードする方法を紹介します。

ここでは、下記のようにごく簡単な構成のテスト環境を用意してみました。
.htaccessでファイルの直アクセスを禁止し、auth.phpで認証に成功しないとsample.pdfファイルがダウンロードできないような仕組みです。

localhost/auth
	1. login.html		ログインページ
	2. auth.php		認証用ページ
	3. down.php		ファイルダウンロード用ページ
	/files
		4. .htaccess	アクセス制限用ファイル
		5. sample.pdf	ダウンロードしたいファイル

※ 下記コードはあくまでもテスト用に書いた簡易的な認証のコードです。実際のサイトには使用しないでください。

1. login.html

<!DOCTYPE html>
<html>
  <head>
    <meta charset="UTF-8">
    <title>認証サンプル</title>
  </head>
  <body>
    <form method="post" action="auth.php">
      <table>
        <tr>
          <td>ユーザー名：</td>
          <td><input name="username" type="text" size="30"></td>
        </tr>
        <tr>
          <td>パスワード：</td>
          <td><input name="password" type="text" size="30"></td>
        </tr>
        <tr>
          <td colspan="2"><input type="submit" value="ログイン"></td>
        </tr>
      </table>
    </form>
  </body>
</html>

2. auth.php

<?php
  define("PW", "pass"); //パスワード
  define("UN", "user"); //ユーザー名
  if(isset($_POST["password"]) && isset($_POST["username"])) {
    if($_POST["password"]===PW && $_POST["username"]===UN){
      session_start();
      $_SESSION["password"] = md5(PW);
      $_SESSION["username"] = md5(UN);
      print "<!DOCTYPE html>\n";
      print "<html>\n";
      print "  <head>\n";
      print "    <meta charset=\"UTF-8\">\n";
      print "    <title>認証確認</title>\n";
      print "  </head>\n";
      print "  <body>\n";
      print '    <a href="./down.php">ファイルのダウンロード</a>' . "\n";
      print "  </body>\n";
      print "</html>";
    }else{
      http_response_code(401);
    }
  }else{
    http_response_code(403);
  }
?>

3. down.php

<?php
  define("PW", "pass"); //パスワード
  define("UN", "user"); //ユーザー名
  session_start();
  if(isset($_SESSION["password"]) && isset($_SESSION["username"])) {
    if($_SESSION["password"]===md5(PW) && $_SESSION["username"]===md5(UN)){
      $file="./files/sample.pdf";
      header("Content-Type: application/octet-stream");
      header("Content-Disposition: attachment; filename=sample.pdf");
      header("Content-Length: " . filesize($file));
      readfile($file);
    }else{
      http_response_code(401);
    }
  }else{
    http_response_code(403);
  }
  session_destroy();
?>

4. .htaccess

<Files ~ "\.(dat|log|csv|pdf)$">
  deny from all
</Files>

上記テスト環境でファイルをダウンロードするためのVBAコードは下記のようになります。

Option Explicit
 
Public Sub Sample04()
  Dim req As Object
  Dim dat As Variant
   
  Const UserName = "user" 'ユーザー名
  Const PassWord = "pass" 'パスワード
  Const AuthUrl = "https://localhost/auth/auth.php" '認証ページのURL
  Const FileUrl = "https://localhost/auth/down.php" 'ダウンロード対象のURL
  Const SaveFilePath = "C:\Test\MyFile.pdf"
  
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  Set req = CreateObject("Msxml2.XMLHTTP")
  
  '認証
  req.Open "POST", AuthUrl, False
  dat = "username=" & UserName & "&password=" & PassWord 'パラメーター設定
  req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  req.Send dat
  If req.Status <> 200 Then
    MsgBox "認証に失敗しました。" & vbCrLf & _
           "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  
  'ファイルのダウンロード
  req.Open "GET", FileUrl, False
  'キャッシュ対策
  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード：" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

ユーザー名やパスワードといったパラメータ(上記コードではdat)を送信し、認証を通過してからファイルのダウンロードを行うやり方です。
(認証のやり方は色々あるので、必ずしも上記コードの方法が使えるわけではありません。)

このとき送信するパラメーターについては、Internet Explorerの開発者ツール(下図はInternet Explorer 11)を使って、実際にログインしたときの挙動をキャプチャーすることで確認できます。

POSTした内容は「Fiddler」等のツールでも確認することができます。

通知バー/Internet Explorerダイアログを操作してファイルをダウンロードする方法

最後に紹介するのが、ファイルをダウンロードしようとしたときに表示されるInternet Explorerの通知バーやInternet Explorerダイアログ((ファイル名) で行う操作を選んでくださいダイアログ)を操作してファイルをダウンロードする方法です。

ただし、この方法はOSやInternet Explorerのバージョンによっては動作しなくなる場合があり、環境に大きく依存するため、私としては正直お薦めしません。

※ UIAutomationClient参照時にエラーが発生する場合は「UIAutomationClient参照時にDLL読み込みエラーが発生した時の対処法」参照

Option Explicit

Public Sub Sample05()
'通知バーを操作してファイルをダウンロード
  Dim elmAnc As Object
  Const READYSTATE_COMPLETE = 4
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate "https://saigai.gsi.go.jp/jusho/download/pref/47.html"
    
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    
    For Each elmAnc In .document.getElementsByTagName("a")
      If InStr(LCase(elmAnc.href), ".zip") Then
        elmAnc.Click '適当なリンクをクリック → ダウンロード通知バー表示
        Exit For
      End If
    Next
    
    DownloadFileNbOrDlg .Hwnd, "C:\Test\TestFile001.zip"
    .Quit
  End With
End Sub

Public Sub Sample06()
'Internet Explorerダイアログを操作してファイルをダウンロード
  Dim elmAnc As Object
  Const READYSTATE_COMPLETE = 4
  
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate "http://www.gender.go.jp/policy/suishin_law/csv_dl/index.html"
    
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    
    For Each elmAnc In .document.getElementsByTagName("a")
      If InStr(LCase(elmAnc.href), ".csv") Then
        elmAnc.Click '適当なリンクをクリック → Internet Explorerダイアログ表示
        Exit For
      End If
    Next
    
    DownloadFileNbOrDlg .Hwnd, "C:\Test\TestFile002.csv"
    .Quit
  End With
End Sub

Private Sub DownloadFileNbOrDlg(ByVal hIE As Long, ByVal SaveFilePath As String)
'通知バー/Internet Explorerダイアログを操作してファイルをダウンロード
'※ UIAutomationClient(%SYSTEMROOT%\system32\UIAutomationCore.dll)要参照
'
' - hIE:InternetExplorerのハンドル
' - SaveFilePath:ファイルのダウンロード先
'
'http://okwave.jp/qa/q8121989.html
'http://okwave.jp/qa/q8320348.html
'https://gist.github.com/kumatti1/7957796 参考

  Dim uiAuto As CUIAutomation
  Dim elmIE As IUIAutomationElement
  Dim elmNotificationBar As IUIAutomationElement
  Dim elmSaveSplitButton As IUIAutomationElement
  Dim elmSaveDropDownButton As IUIAutomationElement
  Dim elmSaveMenu As IUIAutomationElement
  Dim elmSaveMenuItem As IUIAutomationElement
  Dim elmIEDialog As IUIAutomationElement
  Dim elmSaveAsButton As IUIAutomationElement
  Dim elmSaveAsWindow As IUIAutomationElement
  Dim elmFileNameEdit As IUIAutomationElement
  Dim elmSaveButton As IUIAutomationElement
  Dim elmNotificationText As IUIAutomationElement
  Dim elmCloseButton As IUIAutomationElement
  Dim iptn As IUIAutomationInvokePattern
  Dim vptn As IUIAutomationValuePattern
  Const ROLE_SYSTEM_BUTTONDROPDOWN = &H38&
  
  Set uiAuto = New CUIAutomation
  Set elmIE = uiAuto.ElementFromHandle(ByVal hIE)
  
  'ファイルを事前に削除
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(SaveFilePath) Then .DeleteFile SaveFilePath, True
  End With
  
  Do
    '[通知バー]取得
    Set elmNotificationBar = _
      GetElement(uiAuto, _
                 elmIE, _
                 UIA_AutomationIdPropertyId, _
                 "IENotificationBar", _
                 UIA_ToolBarControlTypeId)
    
    '[Internet Explorer]ダイアログ((ファイル名) で行う操作を選んでください)取得
    Set elmIEDialog = _
      GetElement(uiAuto, _
                 elmIE, _
                 UIA_NamePropertyId, _
                 "Internet Explorer", _
                 UIA_WindowControlTypeId)
    DoEvents
  Loop Until (Not elmNotificationBar Is Nothing) Or _
             (Not elmIEDialog Is Nothing)
  
  '***** 通知バー操作ここから *****
  If Not elmNotificationBar Is Nothing Then
    '[保存]スプリットボタン取得
    Set elmSaveSplitButton = _
      GetElement(uiAuto, _
                 elmNotificationBar, _
                 UIA_NamePropertyId, _
                 "保存", _
                 UIA_SplitButtonControlTypeId)
    If elmSaveSplitButton Is Nothing Then GoTo Fin
    
    '[保存]ドロップダウン取得
    Set elmSaveDropDownButton = _
      GetElement(uiAuto, _
                 elmNotificationBar, _
                 UIA_LegacyIAccessibleRolePropertyId, _
                 ROLE_SYSTEM_BUTTONDROPDOWN, _
                 UIA_SplitButtonControlTypeId)
    If elmSaveDropDownButton Is Nothing Then GoTo Fin
    
    '[保存]ドロップダウン押下 -> [名前を付けて保存(A)]ボタン押下
    Set iptn = elmSaveDropDownButton.GetCurrentPattern(UIA_InvokePatternId)
    Do
      iptn.Invoke
      Set elmSaveMenu = _
        GetElement(uiAuto, _
                   uiAuto.GetRootElement, _
                   UIA_ClassNamePropertyId, _
                   "#32768", _
                   UIA_MenuControlTypeId)
      DoEvents
    Loop While elmSaveMenu Is Nothing
    Set elmSaveMenuItem = _
      GetElement(uiAuto, _
                 elmSaveMenu, _
                 UIA_NamePropertyId, _
                 "名前を付けて保存(A)", _
                 UIA_MenuItemControlTypeId)
    If elmSaveMenuItem Is Nothing Then GoTo Fin
    Set iptn = elmSaveMenuItem.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke
  End If
  '***** 通知バー操作ここまで *****
  
  '***** Internet Explorerダイアログ操作ここから *****
  If Not elmIEDialog Is Nothing Then
    Set elmSaveAsButton = _
      GetElement(uiAuto, _
                 elmIEDialog, _
                 UIA_NamePropertyId, _
                 "名前を付けて保存(A)", _
                 UIA_ButtonControlTypeId)
    If elmSaveAsButton Is Nothing Then GoTo Fin
    Set iptn = elmSaveAsButton.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke
  End If
  '***** Internet Explorerダイアログ操作ここまで *****
  
  If (elmNotificationBar Is Nothing) And (elmIEDialog Is Nothing) Then GoTo Fin
  
  '***** 名前を付けて保存操作ここから *****
  '[名前を付けて保存]ダイアログ取得
  Do
    Set elmSaveAsWindow = _
      GetElement(uiAuto, _
                 uiAuto.GetRootElement, _
                 UIA_NamePropertyId, _
                 "名前を付けて保存", _
                 UIA_WindowControlTypeId)
    DoEvents
  Loop While elmSaveAsWindow Is Nothing
  
  '[ファイル名]欄取得 -> ファイルパス入力
  Set elmFileNameEdit = _
    GetElement(uiAuto, _
               elmSaveAsWindow, _
               UIA_NamePropertyId, _
               "ファイル名:", _
               UIA_EditControlTypeId)
  If elmFileNameEdit Is Nothing Then GoTo Fin
  Set vptn = elmFileNameEdit.GetCurrentPattern(UIA_ValuePatternId)
  vptn.SetValue SaveFilePath
  
  '[保存(S)]ボタン押下
  Set elmSaveButton = _
    GetElement(uiAuto, _
               elmSaveAsWindow, _
               UIA_NamePropertyId, _
               "保存(S)", _
               UIA_ButtonControlTypeId)
  If elmSaveButton Is Nothing Then GoTo Fin
  Set iptn = elmSaveButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  '***** 名前を付けて保存操作ここまで *****
  
  '***** ダウンロード完了待ちここから *****
  If elmNotificationBar Is Nothing Then
    '[通知バー]取得
    Do
      Set elmNotificationBar = _
        GetElement(uiAuto, _
                   elmIE, _
                   UIA_AutomationIdPropertyId, _
                   "IENotificationBar", _
                   UIA_ToolBarControlTypeId)
      DoEvents
    Loop While elmNotificationBar Is Nothing
  End If
  
  '[通知バーのテキスト]取得
  Set elmNotificationText = _
    GetElement(uiAuto, _
               elmNotificationBar, _
               UIA_NamePropertyId, _
               "通知バーのテキスト", _
               UIA_TextControlTypeId)
  If elmNotificationText Is Nothing Then GoTo Fin
  
  '[閉じる]ボタン取得
  Set elmCloseButton = _
    GetElement(uiAuto, _
               elmNotificationBar, _
               UIA_NamePropertyId, _
               "閉じる", _
               UIA_ButtonControlTypeId)
  If elmCloseButton Is Nothing Then GoTo Fin
  
  Do
    DoEvents
  Loop Until InStr( _
    elmNotificationText.GetCurrentPropertyValue(UIA_ValueValuePropertyId), _
    "ダウンロードが完了しました") > 0
  
  '[閉じる]ボタン押下
  Set iptn = elmCloseButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  '***** ダウンロード完了待ちここまで *****
  
  Exit Sub
Fin:
  MsgBox "処理が失敗しました。", vbCritical + vbSystemModal
End Sub

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
  
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

上記コードはループで止まったときのことも考慮していませんので、実際にコードを動かす際には、一定時間ループで引っ掛かったら処理を抜ける、というようなコードも追加しておいた方が良いでしょう。

一応通知バーやダイアログも操作できる！ということで、あくまでも最終手段として頭の隅にでも置いておいていただければ・・・、というようなコードです。

また、kumattiさんから下記情報提供がありましたので、64ビット環境でコードが上手く動作しない場合はお試しください。

@kinuasa ども。そう言えばダウンロード用のコードを纏めたページでUI Automationのサンプルは
64BitのVBAで確認しましたが、IsZoomed APIで判定してShowWindowでIE最大化しないと
通知バーのオブジェクトを取得出来ませんでした。#感想

— kumattiザウルス (@kumatti1) 2014年9月26日

というわけで、今回はVBAでインターネット上のファイルをダウンロードする色々な方法をまとめてみました。

ファイルのダウンロードに限らずVBAからWebページを操作する場合、開発者ツールやFiddlerを使って通信内容を確認する、Webページのソースを確認する、といったことは基本中の基本とも言え、どうしても必要になってきます。

ファイルのダウンロード処理で躓いたときは、まずは対象となるサイトをよく見てみることをお薦めします。