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

0.README.md

[Excel] amazonの購入履歴をダウンロードするVBAマクロ

はけたさんの記事「amazonの購入履歴をエクセルでダウンロードするVBAマクロ」中にあったマクロを自分の環境でも動作するように改修したもの。

ブラウザで領収書をまとめて印刷／CSVダウンロードしたい方はこちら

拙作の、ブラウザで動作する拡張機能（アドオン）「アマゾン注文履歴フィルタ」も公開中ですので、よろしければお試し下さい。

amazonrireki_macro.vba

' [amazonの購入履歴をエクセルでダウンロードするVBAマクロ](https://www.excelspeedup.com/amazonkounyuurireki/#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 = "year-2017"
'  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 OrderPrice As Variant
  Dim ItemContent As Variant
  
  Dim R As Long
  R = 2
  
  Dim RegNonNumber As New RegExp
  RegNonNumber.Pattern = "[^0-9]"
  RegNonNumber.Global = True
  
  Dim RegTrim As New RegExp
  RegTrim.Pattern = "(^[\s　]+|[\s　]+$)"
  RegTrim.Global = True
  
  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

'合計金額取得
    OrderPrice = Val(RegNonNumber.Replace(DocOrder(I1).getElementsByClassName("value")(1).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)
        ElseIf .getElementsByClassName("gift-card-instance").Length >= 1 Then
'ギフトカードは価格のタグが違う
          Data(3) = CDbl(.getElementsByClassName("gift-card-instance")(0) _
                     .getElementsByClassName("a-span2")(0).innerHTML)
        Else
'Kindle等の単品物は価格が合計金額の所にしか表示されていない
          Data(3) = OrderPrice
        End If
        
        'Data(4) = Data(2) * Data(3)
        Data(4) = "=OFFSET($B$1,ROW()-1,0,1,1)*OFFSET($C$1,ROW()-1,0,1,1)"
        
        If .getElementsByClassName("a-link-normal").Length >= 2 Then
          ItemContent = .getElementsByClassName("a-link-normal")(1).innerHTML
        ElseIf .getElementsByClassName("a-text-bold").Length >= 1 Then
'商品名のリンクが存在しない場合もある
          ItemContent = .getElementsByClassName("a-text-bold")(0).innerHTML
        Else
          ItemContent = "（詳細不明）"
        End If
        
        'Data(5) = Replace(Replace(Replace(Trim(ItemContent), " ", ""), Chr(13), ""), Chr(10), "")
        Data(5) = RegTrim.Replace(ItemContent, "")
        
        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
 

はけた＠エクセルスピードアップ講座@excelspeedup 氏の

経理・会計事務所向けエクセルスピードアップ講座

に掲載されていたマクロ（2018/2/16版）が自分のところでエラーが出てしまったため、とりあえず動作するように修正したものです。

拙作のブラウザ（Chrome/Firefox）拡張機能でも、注文履歴を CSV でダウンロードできるので、よろしければお試しを。

【アマゾン注文履歴フィルタ】確定申告にも便利かも？！ Kindle 等のデジタルコンテンツの領収書をまとめて表示する拡張機能／アドオン／ユーザースクリプト - 風柳メモ

こちらは、カード支払い情報等も含まれますので、割と便利だと思います。