amazonの購入履歴をエクセルでダウンロードするVBAマクロ

2016年5月9日

預金入出金やクレジットカード明細の自動記帳エクセルマクロを作っているのですが、そこでネックになりそうなのが、Amazonからの購入。
Amazonでは様々なものを購入できるため、Amazonからの購入頻度が多い場合には、自動記帳をしようと思っても限界があります。

マネーフォワードを使うとamazonの購入履歴をダウンロードできるらしい、というので、それなら、エクセルVBAマクロでもAmazonの購入履歴をダウンロードできるだとう、ということで作ってみました。

Amazon購入履歴ダウンロード-エクセルVBAマクロ

下記から、エクセルマクロをダウンロードしてください。
Amazon購入履歴ダウンロードマクロをダウンロードする

あらかじめInternet ExplorerでAmazonにログインしている状態で、「amazon購入履歴取得」というマクロを実行してください。

マクロをそのまま使うと、次のように2016年の購入履歴がエクセルにダウンロードできます。

他の年度の購入履歴をダウンロードしたい場合には、
マクロ内部の「FS = "year-2016"」の部分の「2016」を2015とか2014とかに変えてください。
過去の分もダウンロードできます。

動作の仕組み・注意事項

Amazonの購入履歴画面のHTMLを取得して、該当する部分を抜き出しています。

具体的には、購入履歴画面のHTMLが、次のような作りになっています。

<div class="order">
  <span class="value">注文日</span>
  <div class="shipment">
    <div class="a-fixed-left-grid-inner">
      <span class="item-view-qty">数量</span>
      <a class="a-link-normal">商品名</a>
      <span class="a-color-price">単価</span>
    </div>
  </div>
</div>

そこで、テキストデータを解析して、該当部分を抽出しています。

※ギフトカードなど出荷が伴わないものについては、構造が違うので個別対応しています。ただ、全形態を試したわけではないので、あらゆるデータをダウンロードできるかはわかりません。

このように、現在の画面表示の仕方にあわせてマクロを組んでいますので、Amazonの購入履歴の画面表示の仕方が変わると、データ抽出の方法も変わってしまいます。
当然、画面表示が変わると、今回のマクロは使えなくなります。

また、テキトーに作ったものなので、完璧に動作するか保障はできません。
購入履歴のダウンロード後は、きちんともれなくダウンロードできているか、自力で確認を入れてください。

VBAマクロソースコード

今回のソースコードも念のため、貼っておきます。

以下、修正前のソースです。

Option Explicit

Const URL As String = "https://www.amazon.co.jp/gp/css/order-history/ref=oss_pagination?ie=UTF8&search=&orderFilter="

Public Sub amazon購入履歴取得()
  Dim FS As String
  FS = "year-2016"
'  FS = "months-6"
  
  Dim IE As Object
    
  Dim objShell As Object
  Dim objWin As Object
  
  Set objShell = CreateObject("shell.application")
  For Each objWin In objShell.Windows
    If objWin.Name = "Internet Explorer" Then
      Set IE = objWin
      Exit For
    End If
  Next
  
  If IE Is Nothing Then
    Set IE = CreateObject("InternetExplorer.Application")
  End If

'  ie.Visible = True
  Call IE.Navigate2(URL & FS, &H800, "amazon_get_purchaserecords")

  Application.Wait [Now() + "00:00:05"]

'新規作成したタブを取得
  Dim IE2 As Object
  Dim IE2_Exist As Boolean
  IE2_Exist = False
  
  For Each objWin In objShell.Windows
    If objWin.Name = "Internet Explorer" Then
      Set IE2 = objWin
      If IE2.LocationURL = URL & FS Then
        IE2_Exist = True
        Exit For
      ElseIf IE2.LocationURL Like "*www.amazon.co.jp/ap/signin*" Then
        MsgBox "ログイン後に再度起動してください。プログラムを終了します。"
        End
      End If
    End If
  Next

  If IE2_Exist = False Then
    MsgBox "開いたタブが見つかりませんでした。中止します"
    End
  End If
  
  Do While IE2.Busy = True Or IE2.readyState <> 4
    DoEvents
  Loop


' 結果出力
  Dim Doc As String
  Doc = IE2.Document.body.innerHTML

'件数取得
  Dim OrderCount As String
  OrderCount = IE2.Document.getElementsByClassName("num-orders")(0).innerHTML
  OrderCount = Left(OrderCount, Len(OrderCount) - 1)

  Dim Data(1 To 5) As Variant
'暫定
'1：日付、2：数量、3：単価、4:金額、5：内容


  Dim DocOrder As Variant
  Dim DocShipment As Variant
  Dim DocItemView As Variant
  Dim Page As Long
  Dim I1 As Long
  Dim I2 As Long
  Dim I3 As Long
  Dim I2Items As Long
  
  Dim I3Items As Long
  Dim OrderDate As Variant
  Dim R As Long
  R = 2
  
  Worksheets.Add
  ActiveSheet.Cells(1, 1) = "注文日"
  ActiveSheet.Cells(1, 2) = "数量"
  ActiveSheet.Cells(1, 3) = "単価"
  ActiveSheet.Cells(1, 4) = "金額"
  ActiveSheet.Cells(1, 5) = "内容"
  
  
  
  For Page = 0 To OrderCount - 1 Step 10
   If Page > 0 Then
     Call IE2.Navigate(URL & FS & "&startIndex=" & Page)
     Do While IE2.Busy = True Or IE2.readyState <> 4
       DoEvents
     Loop
   End If
   
   For I1 = 0 To IE2.Document.getElementsByClassName("order").Length - 1
    Set DocOrder = IE2.Document.getElementsByClassName("order")
  
'注文日取得
    OrderDate = DocOrder(I1).getElementsByClassName("value")(0).innerHTML
  
  
'ギフトカードはshipmentがないため別タグを取得
    I2Items = DocOrder(I1).getElementsByClassName("shipment").Length - 1
    If I2Items > 0 Then
      Set DocShipment = DocOrder(I1).getElementsByClassName("shipment")
    Else
      I2Items = DocOrder(I1).getElementsByClassName("a-fixed-right-grid-inner").Length - 1
      Set DocShipment = DocOrder(I1).getElementsByClassName("a-fixed-right-grid-inner")
    End If
    
    For I2 = 0 To I2Items
'数量取得
      Set DocItemView = DocShipment(I2).getElementsByClassName("a-fixed-left-grid-inner")
      I3Items = DocItemView.Length
      
      For I3 = 0 To I3Items - 1
       With DocItemView(I3)
        Data(1) = CDate(OrderDate)
        If .getElementsByClassName("item-view-qty").Length >= 1 Then
          Data(2) = CDbl(.getElementsByClassName("item-view-qty")(0).innerHTML)
        Else
          Data(2) = 1
        End If
        
        If .getElementsByClassName("a-color-price").Length >= 1 Then
          Data(3) = CDbl(.getElementsByClassName("a-color-price")(0).innerHTML)
        Else
'ギフトカードは価格のタグが違う
          Data(3) = CDbl(.getElementsByClassName("gift-card-instance")(0) _
                     .getElementsByClassName("a-span2")(0).innerHTML)
        End If
        
        Data(4) = Data(2) * Data(3)
        Data(5) = Replace(Replace(Replace(Trim(.getElementsByClassName("a-link-normal")(1).innerHTML), " ", ""), Chr(13), ""), Chr(10), "")
        ActiveSheet.Range(ActiveSheet.Cells(R, 1), ActiveSheet.Cells(R, 5)) = Data
      
        R = R + 1
       End With
      Next
    Next
   Next
  Next

  Set IE = Nothing

'  IE2.Quit
  Set IE2 = Nothing
  
End Sub

※2018/2/16　ソースコードを一部修正