【VBA】社内認証基盤を突破して、Webページ上のリンク先データを一括ダウンロードする

2023年7月22日 01:55

Excel VBAで、Webページ上のリンク先ファイルを一括ダウンロードするコードのサンプルです。
HTTP通信にIDとパスワードを乗せてリクエスト送信することで、簡単な認証ページを突破したうえでリンク先データをダウンロードします。
※認証方法によっては突破できないこともあります。

例えば、こんなWebページをブラウザで開いたとします。

下線部のリンクをクリックすると、リンク先ファイルが開かれて閲覧できるという想定です。
下線部のリンクを１つづつクリックして閲覧していく作業が面倒なので、リンク先データを一括ダウンロードしたい！という要望に応えるべく作成しました。

【概要】
・目的のWebページをブラウザのIEモードで開いておく。
・自動操作の流れ
　①対象Webページのウィンドウハンドルを特定。
　　対象WebページをDOM化（IHTMLDocument2オブジェクトを生成）
　②ダウンロード先となるフォルダを生成。
　　ここではMyDownloadフォルダ直下に新規フォルダを生成。
　③対象Webページ内の＜aタグ＞＜/aタグ＞で囲まれたリンク先のデータに
　　アクセス。
　　このとき、社内認証を突破するためのID、パスワード、その他諸々の
　　パラメーターを一緒に送信する。
　④社内認証を突破したら、データをダウンロード。
　⑤次の＜aタグ＞に処理を移し、同様にダウンロード。

コードはこちら。

'ウィンドウ情報（ハンドル・キャプション名・クラス名）取得用API
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As Long) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, lParam As Long) As Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Const GW_HWNDNEXT = &H2
'------------------------
'Edge画面DOM取得用API
Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As LongPtr, ByVal msg As LongPtr, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal fuFlags As LongPtr, ByVal uTimeout As LongPtr, lpdwResult As LongPtr) As LongPtr
Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Object) As LongPtr
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Const SMTO_ABORTIFHUNG = &H2
'------------------------
'Edge画面操作用API
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
'------------------------
'モジュール変数
Private Title As String
Private hWnd As LongPtr
Private IES_hWnd As LongPtr 'クラス名「Internet_Explorer_Server」のハンドル
Private Num As Integer  'ウィンドウハンドル要素数
Private hWnds() As LongPtr 'ウィンドウハンドル配列
Private objEdge As Object 'mshtml.IHTMLDocument2   'IES_hWndウィンドウをDOM化(HTMLDocument化)したオブジェクト


'-----------メイン処理-----------
Private Sub DownloadAll()

    '対象WebページのHTMLDocumentを取得（DOM化することで、aタグ情報を取得しやすくするため）
    Title = "掲示板"
    Call Get_IES_hWnd(Title) 'Sub①
    Call Get_HTMLDocument(IES_hWnd) 'Sub②
    
    'フォルダ作成
    Dim FolderName As String
    Dim startS As Integer
    Dim LengthS As String
    FolderName = IeEdge.getElementsByTagName("A")(0).innerText
    startS = InStr(FolderName, "】") + 1
    LengthS = InStrRev(FolderName, ".")
    FolderName = Mid(FolderName, startS, LengthS - startS)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists("H:\MyDocument\Downloads\" & FolderName) = False Then 'パス存在確認
        fso.CreateFolder ("H:\MyDocument\Downloads\" & FolderName) 'ダウンロード先となるフォルダを作る
    End If
    Set fso = Nothing
    
    'HTTPリクエストを生成
    Dim Req As Object 'WinHttp.WinHttpRequest
    Set Req = CreateObject("WinHttp.WinHttpRequest") '=New WinHttp.WinHttpRequest

    '対象Webページの各リンクを１つづつ処理
    Dim ID As String
    Dim password As String
    ID = "*******"
    password = "********"
    Dim anchor 'As HTMLAnchorElement
    Dim URL As String '対象WebページのURL
    Dim Auth_URL As String '認証ページのURL
    Dim strPath As String
    Auth_URL = "https://xxxyyyzzz/login.fcc"
    For Each anchor In IeEdge.getElementsByTagName("A")
        URL = anchor.href
        '####POST（認証基盤ページをリクエスト）####
        'この際にIDとパスワードその他情報を設定し、認証を突破
        Req.Open "POST", Auth_URL, False
        Req.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        Req.send "Param1=UTF-8&Param2=JP-jp&TARGET=https://------/redir.asp?target=" & URL & "Param3=0&ID=" & ID & "&PASSWORD=" & password
        Debug.Print "認証を突破"
        '####POST（ダウンロード）####
        Req.Open "POST", URL, False
        Req.setRequestHeader "Content-Disposition", "attachment; filename=xxx"  '「Content-Disposition」をPOSTすることでダウンロードできる
        Req.send
        strPath = "H:\MyDocument\Downloads\" & FolderName & "\" & anchor.innerText
        '指定したURLにリクエストを投げ、受け取ったバイナリ形式のレスポンスをADODB.Streamで保存する
        Select Case Req.Status
            Case 200
                With CreateObject("ADODB.Stream")
                    .Type = 1 'adTypeBinary
                    .Open
                    .write Req.responseBody
                    .savetofile strPath, 2 'adSaveCreateOverWrite
                    .Close
                End With
                Debug.Print "ダウンロード完了"
            Case Else
                MsgBox "エラーが発生しました。" & vbCrLf & "ステータスコード：" & Req.satus, vbCritical + vbSystemModal
                Exit Sub
            End Select
        Next
        Set Req = Nothing
        Set fso = Nothing
End Sub
'-----------メイン処理（おわり）-----------

'-----------サブルーチン処理----------
Sub Get_IES_hWnd(ByVal Title As String)　'Sus①
　'ここは割愛
End Sub

Private Sub Get_HTMLDocument(IES_hWnd As LongPtr)　'Sub②
　'ここは割愛
End Sub
'-----------サブルーチン処理（おわり）----------

対象WebページのHTMLソースの中から、リンク先である＜aタグ＞のデータを根こそぎHTTP通信でダウンロードするのが目的ですが、その際に認証ページに邪魔されても突破するぜ！という趣旨です。
まずは、＜aタグ＞の情報を扱いやすくするために、WebページをDOM操作できるようにします。その処理はサブルーチン部で行っていますが、本記事の主題ではないので割愛します。この部分は別記事で紹介しているので、そちらの「サブルーチン処理」をコピペして使って下さい。

IDとパスワードは、いつも認証用に使っているものと差し替えてください。コード中では「********」表記になっています。

「For Each anchor In IeEdge.getElementsByTagName("A")」
で＜aタグ＞を特定したら、いよいよダウンロード処理に入ります。
まずは
「Req.Open "POST", Auth_URL, False」
で認証ページを指定し、リクエストボディに必要情報（ID、パスワード、その他パラメーター）を含めて送信します。
認証基盤を突破（ログイン）するためには、いつも手入力しているID、パスワードの他にも隠されたパラメータを全部一緒に送信しないとダメです。
なお、こちらの外部サイトから引用させて頂きます。

ログインするためには、ログインするにあたって必要なinputタグ内のname属性とvalue属性を全部POSTする必要があるので、ログインに失敗しているということは、まず必要な情報を送信していないことになります。
必要な情報はIDとパスワードだけじゃないの？と思うかもしれませんが、実はログインとか重要な情報を扱うときは総当り攻撃とか悪意のある不正なリクエストを自動で行われたりしないようにログインフォームに値を隠しておいてそれが人間がちゃんと送ってきた情報なのか判断します(しないサイトもある)。今回はその情報が不足しているためにログインエラーがでているのだと考えられます。ちなみに、ログインフォームに隠された値はアクセス毎にランダムに変化するので推測することはほぼ不可能だと考えたほうがいいかもしれません。(サイトによっては値が変化しない仕様のところもある)

なるほどね！わかりやすいです。
では隠されたパラメータである、＜inputタグ＞内のname属性とvalue属性の項目は、具体的にどう確認するのか？
方法は２通り。
①ブラウザの開発者ツール＞ネットワークタブでログを取りながら、実際にどんなパラメーターが送信されているかをペイロード画面で確認する。
②認証ページのHTMLやJavaScriptコードを地道に紐解く。

…まあ、普通に考えて①ですよね。
認証基盤ページの構成環境によって変わるので正解はありませんが、イメージしやすい様、今回の認証ページのHTMLソースコードも載せておきます。黄色部分が”必要情報”です。
今回の例でいうと、＜formタグ＞内のname属性が付いている全ての項目（hidden属性も含む）を全てリクエストボディに追加する必要がありました。

この場合、リクエストボディに含めるパラメーターは
「"Param1=UTF-8&Param2=JP-jp&TARGET=https://------/redir.asp?target=" & URL & "Param3=0&ID=" & ID & "&PASSWORD=" & password」となります。

無事に突破（ログイン）出来たら、
「Req.Open "POST", URL, False」
でリンク先のURLを指定し、リクエストヘッダに「Content-Disposition」を含めてPOSTすることで、ダウンロードができます。
以上、リンク先データの一括ダウンロードマクロの紹介でした。

ちなみに上記サンプルの例では、対象Webページに余計なリンク先が一切無いことが前提条件となります。
つまり表示ページ内の全てのリンク先を無条件でダウンロードするサンプルコードなので、別のWebページに飛ぶようなハイパーリンクが沢山あるページでは本来不要なデータまで保存してしまったり、エラーが出ます。
使うシチュエーションを選ぶマクロですが、使いこなせれば非常に重宝します。
リンク先データのダウンロードって、意外と実行する機会は多いと思うんですよね。Webページの構成に合わせて、適宜カスタマイズしてみてください。

この記事が気に入ったらサポートをしてみませんか？