【Excel VBA】スクレイピングでAmazonの領収書を自動ダウンロード(個人の非営利目的利用に限る)(「SeleniumBasic」を利用)

VBA

2022年6月26日現在のWebサイトでスクレイピングしています。今後サイトの仕様に変更があった場合は、下記のコードではスクレイピングできない場合があります>

「Excel VBA」の「SeleniumBasic」を利用したスクレイピングで、Amazonの領収書を自動ダウンロードするコードを記載します。

「Python」では、Amazonの領収書を自動ダウンロードするコードは公開されていますが、「VBA」では見つかりませんでしたので、掲示しておきたいと思います。

【前提】
1.「SeleniumBasic」は既にお使いのパソコン等にインストールされているものとします。
  ⇒「SeleniumBasic」のインストール方法はコチラ
2.「WebDriver」は「Edge」か「Chrome」を利用します。
  ⇒下記フォルダに各ブラウザの最新バージョンのWebDriverが保存されているものとします。
   C:\Users\USERNAME\AppData\Local\SeleniumBasic
3.Amazonの利用者は、「商業目的または第三者のために行う」データ収集や抽出ツールの
  使用は、利用規約で禁止されておりますので、ご注意願います。(詳細はコチラ) 

下記のコードでは、2022年に購入したすべての領収書を「html」ファイルに保存しています。

Option Explicit

Sub Amazon_領収書_HTML化_Selenium()

    Dim Driver As New Selenium.WebDriver
    
    On Error Resume Next
    
    With Driver
    .Start "Edge"    '"Edge"のところを"Chrome"とすれば「Chrome」で開く
        .Window.Maximize
        .Get "https://www.amazon.co.jp/"    'AmazonのHPを開く
    .FindElementByCss("#nav-orders").Click  '注文履歴をクリック
        .FindElementByCss("#ap_email").SendKeys "ログインID(メールアドレス等)"
        .FindElementByCss("#continue").Click    '次へ進むをクリック
        .FindElementByCss("#ap_password").SendKeys "パスワード"
        .FindElementByCss("#signInSubmit").Click    'ログインボタンをクリック        
        .FindElementByCss("#a-autoid-1-announce").Click    '範囲選択ボタンをクリック
        .FindElementByPartialLinkText("2022年").Click  '2022年を選択
    End With

    '該当の領収書のURLをコレクションに格納
    Dim colls As New Collection
    Dim flg As Boolean    
    flg = True
    'フラグがTrueの間ループ
    Do While flg
        Dim trgElms As Selenium.WebElements
        Dim trgElm As Selenium.WebElement
        Dim trgUrl As Variant
        Set trgElms = Driver.FindElementsByXPath("//a[@class='a-link-normal']")
        For Each trgElm In trgElms
            trgUrl = trgElm.Attribute("href")
            Debug.Print trgUrl
            colls.Add trgUrl
        Next trgElm
        '「次へ」をクリック
        Driver.FindElementByCss _
          ("#ordersContainer > div.a-row > div > ul > li.a-last > a").Click
        '「次へ」がクリックできなくなれば、フラグをFalseにしてループ終了
        If Err.Number = 7 Then flg = False
    Loop

    Dim coll_URL As Variant
    'コレクションに格納した領収書のURLをひとつずつ取り出し
    For Each coll_URL In colls
        '該当のURLに「orderID」が含まれているものだけ「html」ファイルにして保存
        If InStr(coll_URL, "orderID") > 1 Then
            Driver.Get coll_URL
            '領収書のタイトルをファイル名にする
            Dim fName As String
            fName = Driver.FindElementByClass("h1").Text
            Dim strFile As String
            strFile = "C:\Users\USERNAME\Documents\" & fName & ".html"    
            '「html」ファイルを上記フォルダに新規に作成して、
      '領収書のページソースを書き込む
            Dim fileNo As Integer
            fileNo = FreeFile
            Open strFile For Append As #fileNo
           Print #fileNo, Driver.PageSource
            Close #fileNo
        End If
    Next coll_URL    'コレクションに格納したURLの数だけ繰り返す
    
    MsgBox "終了"
    
End Sub

コメント

タイトルとURLをコピーしました