はけたさんの記事「amazonの購入履歴をエクセルでダウンロードするVBAマクロ」中にあったマクロを自分の環境でも動作するように改修したもの。
拙作の、ブラウザで動作する拡張機能(アドオン)「アマゾン注文履歴フィルタ」も公開中ですので、よろしければお試し下さい。
はけたさんの記事「amazonの購入履歴をエクセルでダウンロードする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 | |
拙作のブラウザ(Chrome/Firefox)拡張機能でも、注文履歴を CSV でダウンロードできるので、よろしければお試しを。
こちらは、カード支払い情報等も含まれますので、割と便利だと思います。