EXCEL VBAからPAAPI5を利用できる方法を紹介します。JavaやPHP、Pythonなどサンプルはよく見かけますが、VBAのサンプルが見つからなかったので今回作成しました。
前提条件
一番大事な部分です。ご自身のアカウントでProduct Advertising API 5.0 Scratchpadにて情報取得できるか確認をお願いします。Scratchpadで情報取得できない場合は、これから説明する内容は無意味となってしまいます。
事前準備
自前で全て作成するのは大変なので、色々と取り込んでいます。
.NET Framework 3.5のインストール
コマンドラインから「OptionalFeatures.exe」を起動してください。Windows の機能の有効化または無効化のダイアログが表示されます。.NET Framework 3.5(.NET 2.0および3.0を含む)にチェックをいれてOKを押してください。
参照設定
DictionaryとXMLHTML60クラスを使います。参照設定にてMicrosoft Scripting RuntimeとMicrosoft XML, v6.0をONにしておいてください。設定方法は以下記事を参考にしてください。
VBA-JSONのインストール
PAAPI5でのリクエストおよびレスポンスでJSONを利用します。コンバートおよびパースが必要となります。自前で準備するのは厳しいのでVBA-JSONを利用してます。インストール方法は以下記事を参考にしてください。
サンプルプログラム
Amazonから提供されているPHPのサンプルをベースに作成しました。ブックやシートに依存しないように作成していますご自身の利用目的に合わせて改造してもらえればと思います。
だらだら書いたため無駄な部分や汚い部分が色々と・・。少しずつ修正していきたいと思います。
まずはメインプログラムです。ThisWorkbookあたりに入れてもらえれば。アクセスキーなどはご自身の環境に合わせて修正してください。
Option Explicit
Const ACCESS_KEY = "********************" ' アクセスキー
Const SECRET_KEY = "****************************************" ' シークレットキー
Const PARTNER_TAG = "**********" ' パートナータグ
Const SERVICE_NAME = "ProductAdvertisingAPI"
Const REGION = "us-west-2"
Const HOST = "webservices.amazon.co.jp"
Const URI_PATH = "/paapi5/searchitems"
Const REQUEST_METHOD = "POST"
Function Paapi() As String
Dim payloadRoot As Dictionary, payloadResources As Collection
Set payloadRoot = New Dictionary
Set payloadResources = New Collection
payloadRoot.Add "Keywords", "M590" ' キーワードはM590
With payloadResources ' 必要なリソースはカスタマイズください
.Add "Images.Primary.Medium"
.Add "ItemInfo.Title"
.Add "Offers.Listings.Price"
End With
payloadRoot.Add "Resources", payloadResources
payloadRoot.Add "PartnerTag", PARTNER_TAG
payloadRoot.Add "PartnerType", "Associates"
payloadRoot.Add "Marketplace", "www.amazon.co.jp"
Dim payload As String
payload = JsonConverter.ConvertToJson(payloadRoot)
Dim paapi5 As AwsV4: Set paapi5 = New AwsV4
paapi5.setAccessKey (ACCESS_KEY)
paapi5.setSecretKey (SECRET_KEY)
paapi5.setRegionName (REGION)
paapi5.setServiceName (SERVICE_NAME)
paapi5.setPath (URI_PATH)
paapi5.setRequestMethod (REQUEST_METHOD)
paapi5.setPayload (payload)
Dim headers As Dictionary
Set headers = paapi5.getHeaders()
Dim headerString As String
headerString = ""
Dim key As Variant
For Each key In headers
headerString = headerString & key & ": " & headers.Item(key) & vbCrLf
Next
Dim httpReq As XMLHTTP60
Set httpReq = New XMLHTTP60
httpReq.Open "POST", "https://" & HOST & URI_PATH
httpReq.setRequestHeader "content-encoding", headers("content-encoding")
httpReq.setRequestHeader "content-type", headers("content-type")
httpReq.setRequestHeader "host", HOST
httpReq.setRequestHeader "x-amz-target", headers("x-amz-target")
httpReq.setRequestHeader "x-amz-date", headers("x-amz-date")
httpReq.setRequestHeader "Authorization", headers("Authorization")
httpReq.send payload
Do While httpReq.readyState < 4
DoEvents
Loop
Debug.Print httpReq.responseText
End Function
クラスモジュールです。クラスモジュールの挿入から追加してください。クラス名はAwsV4としてください。
Option Explicit
Private accessKey As String
Private secretKey As String
Private path As String
Private regionName As String
Private serviceName As String
Private httpMethodName As String
Private queryParametes As Dictionary
Private awsHeaders As Dictionary
Private payload As String
Private HMACAlgorithm As String
Private aws4Request As String
Private strSignedHeader As String
Private xAmzDate As String
Private currentDate As String
Private Sub Class_Initialize()
Set queryParametes = New Dictionary
Set awsHeaders = New Dictionary
HMACAlgorithm = "AWS4-HMAC-SHA256"
aws4Request = "aws4_request"
Set awsHeaders = New Dictionary
awsHeaders.Add "content-encoding", "amz-1.0"
awsHeaders.Add "content-type", "application/json; charset=utf-8"
awsHeaders.Add "host", "webservices.amazon.co.jp"
awsHeaders.Add "x-amz-target", "com.amazon.paapi5.v1.ProductAdvertisingAPIv1.SearchItems"
xAmzDate = getDate
currentDate = getTimeStamp
End Sub
Public Sub setAccessKey(paccessKey)
accessKey = paccessKey
End Sub
Public Sub setSecretKey(psecretKey)
secretKey = psecretKey
End Sub
Public Sub setRegionName(pregionName)
regionName = pregionName
End Sub
Public Sub setServiceName(pserviceName)
serviceName = pserviceName
End Sub
Public Sub setPath(ppath)
path = ppath
End Sub
Public Sub setPayload(ppayload)
payload = ppayload
End Sub
Public Sub setRequestMethod(prequestMethod)
httpMethodName = prequestMethod
End Sub
Private Function prepareCanonicalRequest() As String
Dim canonicalURL As String
canonicalURL = ""
canonicalURL = canonicalURL & httpMethodName & vbLf
canonicalURL = canonicalURL & path & vbLf & vbLf
Dim signedHeaders As String
signedHeaders = ""
Dim key As Variant
For Each key In awsHeaders
signedHeaders = signedHeaders & key & ";"
canonicalURL = canonicalURL & key & ":" & awsHeaders.Item(key) & vbLf
Next
canonicalURL = canonicalURL & vbLf
strSignedHeader = Left(signedHeaders, Len(signedHeaders) - 1)
canonicalURL = canonicalURL & strSignedHeader & vbLf
canonicalURL = canonicalURL & generateHex(payload)
prepareCanonicalRequest = canonicalURL
End Function
Private Function prepareStringToSign(canonicalURL As String) As String
Dim stringToSign As String
stringToSign = ""
stringToSign = stringToSign & HMACAlgorithm & vbLf
stringToSign = stringToSign & xAmzDate & vbLf
stringToSign = stringToSign & currentDate & "/" & regionName & "/" & serviceName & "/" & aws4Request & vbLf
stringToSign = stringToSign & generateHex(canonicalURL)
prepareStringToSign = stringToSign
End Function
Private Function calculateSignature(stringToSign As String) As String
Dim signatureKey() As Byte
signatureKey = getSignatureKey(secretKey, currentDate, regionName, serviceName)
Dim signature() As Byte
signature = hashHmac2(stringToSign, signatureKey)
calculateSignature = LCase(btos(signature))
End Function
Public Function getHeaders()
awsHeaders.Add "x-amz-date", xAmzDate
kSort awsHeaders
' Step 1: CREATE A CANONICAL REQUEST
Dim canonicalURL As String
canonicalURL = prepareCanonicalRequest()
' Step 2: CREATE THE STRING TO SIGN
Dim stringToSign As String
stringToSign = prepareStringToSign(canonicalURL)
' Step 3: CALCULATE THE SIGNATURE
Dim signature As String
signature = calculateSignature(stringToSign)
' Step 4: CALCULATE AUTHORIZATION HEADER
If signature <> "" Then
awsHeaders.Add "Authorization", buildAuthorizationString(signature)
Set getHeaders = awsHeaders
End If
End Function
Private Function buildAuthorizationString(strSignature)
buildAuthorizationString = HMACAlgorithm & " Credential=" & accessKey & "/" & getTimeStamp() & "/" & regionName & "/" & serviceName & "/" & aws4Request & ",SignedHeaders=" & strSignedHeader & ",Signature=" & strSignature
End Function
Private Function getSignatureKey(key As String, cddate As String, regionName As String, serviceName As String) As Byte()
Dim objUTF8: Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
Dim kSecret As String: kSecret = "AWS4" & key
Dim kbytes() As Byte: kbytes = objUTF8.Getbytes_4(kSecret)
Dim kDate() As Byte: kDate = hashHmac2(cddate, kbytes)
Dim kRegion() As Byte: kRegion = hashHmac2(regionName, kDate)
Dim kService() As Byte: kService = hashHmac2(serviceName, kRegion)
Dim kSigning() As Byte: kSigning = hashHmac2(aws4Request, kService)
getSignatureKey = kSigning
End Function
Public Function generateHex(str As String) As String
Dim objSHA256: Set objSHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")
Dim objUTF8: Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
Dim bytes() As Byte: bytes = objUTF8.Getbytes_4(str)
Dim hash() As Byte: hash = objSHA256.ComputeHash_2((bytes))
Dim i As Integer
Dim tmp
For i = 1 To UBound(hash) + 1
tmp = tmp & Right("0" & Hex(AscB(MidB(hash, i, 1))), 2)
Next i
generateHex = LCase(tmp)
Set objSHA256 = Nothing
Set objUTF8 = Nothing
End Function
' NET Framewrok3.5 が必要 https://paso-kake.com/it/windows11/12969/
Public Function hashHmac2(str As String, ByRef key() As Byte) As Byte()
Dim objSHA256: Set objSHA256 = CreateObject("System.Security.Cryptography.HMACSHA256")
Dim objUTF8: Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
Dim strbytes() As Byte: strbytes = objUTF8.Getbytes_4(str)
objSHA256.key = key
Dim hash() As Byte: hash = objSHA256.ComputeHash_2(strbytes)
Set objSHA256 = Nothing
Set objUTF8 = Nothing
hashHmac2 = hash
End Function
Private Function getTimeStamp() As String
Dim wmDate As Object
Set wmDate = CreateObject("WbemScripting.SWbemDateTime")
wmDate.SetVarDate Now()
getTimeStamp = Format(wmDate.GetVarDate(False), "yyyymmdd")
End Function
Private Function getDate() As String
Dim wmDate As Object
Set wmDate = CreateObject("WbemScripting.SWbemDateTime")
wmDate.SetVarDate Now()
getDate = Format(wmDate.GetVarDate(False), "yyyymmddThhnnssZ")
End Function
Private Function btos(bytes() As Byte) As String
Dim i As Integer
Dim tmp
For i = 1 To UBound(bytes) + 1
tmp = tmp & Right("0" & Hex(AscB(MidB(bytes, i, 1))), 2)
Next i
btos = tmp
End Function
Private Sub kSort(ByRef header As Dictionary)
Dim list As Object
Dim arrKeys As Variant
Dim arrSort As Variant
Dim varItem As Variant
Dim i As Long
arrKeys = header.Keys
Set list = CreateObject("System.Collections.ArrayList")
For i = LBound(arrKeys) To UBound(arrKeys)
list.Add arrKeys(i)
Next
list.Sort
arrSort = list.ToArray
For i = LBound(arrSort) To UBound(arrSort)
varItem = header.Item(arrSort(i))
header.Remove arrSort(i)
header.Add arrSort(i), varItem
Next
End Sub
