はじめに
ではAmazon MWS API を使用して商品情報を取得する方法について、書いていきたいと思います。
その前にまずは接続確認をしてみましょう!
簡単なパラメータを送信して、ちゃんと返ってくるか。
これができなければ始まりません。
恐らく一番難しいところです。
接続さえできてしまえばあとはどのパラメータを渡すかだけなので…
がんばっていきましょう!
※Excel VBAがある程度できることを前提として書きます。
Excel VBAでMWS APIの接続確認をする方法
結論から先に載せます。
いきなり長い記述になってしまいますが、あとで解説するので分からない方はそのまま読み進めてください!
認証ボタンクリック時処理
Option Explicit '認証ボタンクリック時処理 Private Sub BTN_認証_Click() Dim param As String Dim paramToSign As String Dim sellerId As String Dim accessKey As String Dim seacretKey As String Dim endPoint As String Dim marketPlaceId As String Dim timeStamp As String Dim apiVersion As String Dim country As String Dim sign As String Dim url As String Dim xml As Object Dim objSeller As Object Dim objErr As Object Dim wkObj As Object Dim errMsg As String 'パラメータの取得 sellerId = Range("B1").Value accessKey = Range("B2").Value seacretKey = Range("B3").Value country = "JP" If country = "JP" Then '日本 endPoint = "mws.amazonservices.jp" marketPlaceId = "A1VC38T7YXB528" url = "https://mws.amazonservices.jp/Sellers/2011-07-01" ElseIf country = "US" Then 'アメリカ endPoint = "mws.amazonservices.com" marketPlaceId = "ATVPDKIKX0DER" url = "https://mws.amazonservices.com/Sellers/2011-07-01" End If timeStamp = Format(CDate(DateAdd("h", -9, Now)), "yyyy-mm-dd") & "T" & Format(CDate(DateAdd("h", -9, Time)), "hh%3AMM%3Ass") & "Z" apiVersion = "2011-07-01" ' リクエストを作成(パラメータはアルファベット順なので順番を変えるとNG) param = "AWSAccessKeyId=" & accessKey _ & "&Action=ListMarketplaceParticipations" _ & "&SellerId=" & sellerId _ & "&SignatureMethod=HmacSHA256" _ & "&SignatureVersion=2" _ & "&Timestamp=" & timeStamp _ & "&Version=" & apiVersion 'Signatureの取得 paramToSign = "POST" & vbLf & endPoint & vbLf & "/Sellers/2011-07-01" & vbLf & param sign = GetSign(seacretKey, paramToSign) param = param & "&Signature=" & sign '結果XMLを取得 Set xml = getXMLPost(url, param) Set objSeller = xml.SelectNodes("ListMarketplaceParticipationsResponse") If objSeller.Length > 0 Then '取得できていれば接続成功! MsgBox "認証完了", vbInformation Else '取得できなければエラーなので、エラー内容を取得して表示 Set objErr = xml.SelectNodes("ErrorResponse/Error") If objErr.Length > 0 Then Set wkObj = objErr(0).SelectSingleNode("Message") If Not wkObj Is Nothing Then errMsg = wkObj.text End If End If MsgBox "認証失敗" & vbCrLf & errMsg, vbCritical End If End Sub
標準モジュール:hash
'advapi32.dll 'http://su-u.jp/juju/%B5%A4%A4%DE%A4%B0%A4%EC%C6%FC%B5%AD/2007-03-08.html Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _ (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _ ByVal dwProvType As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptReleaseContext Lib "advapi32.dll" _ (ByVal hProv As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptCreateHash Lib "advapi32.dll" _ (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _ ByRef phHash As Long) As Long Private Declare Function CryptDestroyHash Lib "advapi32.dll" _ (ByVal hHash As Long) As Long Private Declare Function CryptHashData Lib "advapi32.dll" _ (ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptGetHashParam Lib "advapi32.dll" _ (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _ ByVal dwFlags As Long) As Long Private Const PROV_RSA_FULL As Long = 1 Private Const PROV_RSA_AES As Long = 24 Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000 Private Const HP_HASHVAL As Long = 2 Private Const HP_HASHSIZE As Long = 4 Private Const ALG_TYPE_ANY As Long = 0 Private Const ALG_CLASS_HASH As Long = 32768 Private Const ALG_SID_MD2 As Long = 1 Private Const ALG_SID_MD4 As Long = 2 Private Const ALG_SID_MD5 As Long = 3 Private Const ALG_SID_SHA As Long = 4 Private Const ALG_SID_SHA_256 As Long = 12 Private Const ALG_SID_SHA_384 As Long = 13 Private Const ALG_SID_SHA_512 As Long = 14 Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2) Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4) Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5) Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA) Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256) Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384) Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512) ' Create Hash Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String Dim hProv As Long, hHash As Long Dim abytHash(0 To 63) As Byte Dim lngLength As Long Dim lngResult As Long Dim strHash As String Dim i As Long strHash = "" If CryptAcquireContext(hProv, vbNullString, vbNullString, _ IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _ CRYPT_VERIFYCONTEXT) <> 0& Then If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then lngLength = UBound(abytData()) - LBound(abytData()) + 1 If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _ Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&) If lngResult <> 0& Then lngLength = UBound(abytHash()) - LBound(abytHash()) + 1 If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then For i = 0 To lngLength - 1 strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2) Next End If End If CryptDestroyHash hHash End If CryptReleaseContext hProv, 0& End If CreateHash = LCase$(strHash) End Function ' Create Hash From String(Shift_JIS) Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID) End Function ' Create Hash From File Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String Dim abytData() As Byte Dim intFile As Integer Dim lngError As Long On Error Resume Next If Len(Dir(strFileName)) > 0 Then intFile = FreeFile Open strFileName For Binary Access Read Shared As #intFile abytData() = InputB(LOF(intFile), #intFile) Close #intFile End If lngError = Err.Number On Error GoTo 0 If lngError = 0 Then CreateHashFile = CreateHash(abytData(), lngAlgID) _ Else CreateHashFile = "" End Function ' MD5 Public Function CreateMD5Hash(abytData() As Byte) As String CreateMD5Hash = CreateHash(abytData(), CALG_MD5) End Function Public Function CreateMD5HashString(ByVal strData As String) As String CreateMD5HashString = CreateHashString(strData, CALG_MD5) End Function Public Function CreateMD5HashFile(ByVal strFileName As String) As String CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5) End Function ' SHA-1 Public Function CreateSHA1Hash(abytData() As Byte) As String CreateSHA1Hash = CreateHash(abytData(), CALG_SHA) End Function Public Function CreateSHA1HashString(ByVal strData As String) As String CreateSHA1HashString = CreateHashString(strData, CALG_SHA) End Function Public Function CreateSHA1HashFile(ByVal strFileName As String) As String CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA) End Function ' SHA-256 Public Function CreateSHA256Hash(abytData() As Byte) As String CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256) End Function Public Function CreateSHA256HashString(ByVal strData As String) As String CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256) End Function Public Function CreateSHA256HashFile(ByVal strFileName As String) As String CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256) End Function ' SHA-384 Public Function CreateSHA384Hash(abytData() As Byte) As String CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384) End Function Public Function CreateSHA384HashString(ByVal strData As String) As String CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384) End Function Public Function CreateSHA384HashFile(ByVal strFileName As String) As String CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384) End Function ' SHA-512 Public Function CreateSHA512Hash(abytData() As Byte) As String CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512) End Function Public Function CreateSHA512HashString(ByVal strData As String) As String CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512) End Function Public Function CreateSHA512HashFile(ByVal strFileName As String) As String CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512) End Function
標準モジュール:common
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Hmac-SHA256 'http://plus-sys.jugem.jp/?eid=215 Public Function GetSign(sKey, rawTextToSign As String) As String Dim arKey() As Byte Dim ipad As String Dim opad As String Dim hash, hash_2, hash_cut2, hash_10, hash_cut10 As String Dim buff() As Byte, offset As Integer Dim sign As String Dim base64Array As Variant '初期化 ipad = "" opad = "" hash = "" ReDim arKey(0 To 63) '秘密鍵から1文字づつ読込み、文字コードへ変換後配列へ格納 For i = 0 To Len(sKey) - 1 arKey(i) = Asc(Mid(sKey, i + 1, 1)) Next '64文字に満たない分は、ゼロセット For i = Len(sKey) To 63 arKey(i) = 0 Next 'innerpad及びouterpad作成 For i = 0 To 63 ipad = ipad & Chr(arKey(i) Xor &H36) opad = opad & Chr(arKey(i) Xor &H5C) Next 'ハッシュ処理1回目 '(innerpad+メッセージ文字列)をハッシュ・・・ハッシュ結果1 hash = CreateSHA256HashString(ipad & rawTextToSign) 'ハッシュ処理2回目 buff = StrConv(opad, vbFromUnicode) offset = UBound(buff) ReDim Preserve buff(offset + Len(hash) \ 2) For i = 1 To (Len(hash) \ 2) buff(offset + i) = CByte("&H" & Mid(hash, (i - 1) * 2 + 1, 2)) Next hash = CreateSHA256Hash(buff) '2進数に変換 hash_2 = "" For k = 1 To 64 Step 2 hash_cut2 = Mid(hash, k, 2) hash_2 = hash_2 & HEX2BIN(hash_cut2) Next '不足が出るので00で埋める hash_2 = hash_2 & "00" 'BASE64エンコード sign = "" For k = 1 To 256 Step 6 hash_cut10 = Mid(hash_2, k, 6) hash_10 = ncdec(2, hash_cut10) base64Array = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/") sign = sign & base64Array(hash_10) Next '不足が出るので=で埋める sign = sign & "=" 'URLエンコード sign = UrlEncode(sign) GetSign = sign End Function Function StrHex(text As String) As String Dim lCount As Long Dim sResult As String Dim lLength As Long lLength = Len(text) For lCount = 1 To lLength Step 2 sResult = sResult & Chr(Val("&H" & Mid(text, lCount, 2))) Next StrHex = sResult End Function 'URL エンコード 'http://www.geocities.co.jp/SilkRoad/4511/vb/urlenc.htm Public Function UrlEncode(ByRef strSource As String) As String Dim lngLength As Long '文字列のサイズ(S-JIS 変換後)を格納する Dim bytSource() As Byte 'ANSI/S-JIS に変換した文字列を格納するバイト型配列 Dim strBuffer As String 'URL エンコードされた文字列を一時格納するバッファ Dim bytSingle As Byte '配列から抜き出した 1 バイトを格納する Dim strSingleHex As String '文字コードを 16 進化した文字列を格納する Dim lngReadCount As Long 'bytSource 読み込み位置カウンタ Dim lngWriteCount As Long 'strBuffer 書き込み位置カウンタ lngLength = LenB(StrConv(strSource, vbFromUnicode)) 'ANSI/S-JIS 変換後のサイズを求める If Not CBool(lngLength) Then Exit Function '0 バイトの場合関数を抜ける ReDim bytSource(lngLength - 1) 'ANSI/S-JIS 変換文字列を格納する領域を確保 bytSource = StrConv(strSource, vbFromUnicode) 'ANSI/S-JIS に変換し bytSource に格納 strBuffer = String$(lngLength * 3, vbNullChar) 'URL エンコード文字列一時格納バッファを確保 strSingleHex = "%00" '16 進化した文字コードを格納するバッファを確保 lngWriteCount = 1 '書き込みカウンタは 1 から開始 Do '文字列の終端までループ bytSingle = bytSource(lngReadCount) '配列から 1 バイト抜く(毎回参照するより速い?) If ((bytSingle >= &H81) And (bytSingle <= &H9F)) Or _ ((bytSingle >= &HE0) And (bytSingle <= &HEF)) Then 'Shift-JIS 2 バイト文字と確認された場合 Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換(上位バイト) Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす If lngReadCount = lngLength Then Exit Do '文字列の終端に達した場合、ループを抜ける bytSingle = bytSource(lngReadCount) '配列から 1 バイト抜く Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換(下位バイト) Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす ElseIf bytSingle = &H20 Then '半角スペース文字(" ")の場合 Mid(strBuffer, lngWriteCount, 1) = "+" '"+" を代わりに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 1 '書き込みカウンタを 1 増やす ElseIf ((bytSingle >= &H40) And (bytSingle <= &H5A)) Or _ ((bytSingle >= &H61) And (bytSingle <= &H7A)) Or _ ((bytSingle >= &H30) And (bytSingle <= &H39)) Or _ (bytSingle = &H2A) Or _ (bytSingle = &H2D) Or _ (bytSingle = &H2E) Or _ (bytSingle = &H5F) Then '無変換文字であった場合 Mid(strBuffer, lngWriteCount, 1) = Chr$(bytSingle) '文字コードを文字列に戻して書き込む(^^; lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 1 '書き込みカウンタを 1 増やす Else 'その他の文字の場合 If bytSingle <= &HF Then 'Hex$() の結果が 1 文字になる場合 Mid(strSingleHex, 2, 1) = "0" '0 を先頭に付加 Mid(strSingleHex, 3, 1) = Hex$(bytSingle) '文字コードを 16 進数に変換 Else '0 を付加する必要がない場合 Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換 End If Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす End If Loop Until lngReadCount = lngLength Erase bytSource 'バイト型配列を消去 If lngWriteCount > 1 Then 'バッファに文字列が書き込まれた場合 UrlEncode = Left$(strBuffer, lngWriteCount - 1) 'バッファの余分な部分を削り、戻り値とする End If End Function Public Function HEX2BIN(ByVal hx As String) As String Dim num As Long Dim bin As String Dim i As Integer num = CLng("&H" & hx) For i = Len(hx) * 4 - 1 To 0 Step -1 bin = bin & -CLng((num And (2 ^ i)) <> 0) Next HEX2BIN = bin End Function 'n進数の文字列strNumberを10進数の数字に変換して返す 'http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/Convert.htm Public Function ncdec(ByVal n As Long, ByVal strNumber As String) As Long Dim lngt As Long Dim c As Long Dim i As Long lngt = 0& c = 1& For i = 1& To Len(strNumber) lngt = lngt + subncdec(Left$(Right$(strNumber, i), 1)) * c c = c * n Next i ncdec = lngt End Function Public Function subncdec(ByVal b As String) As Long Dim r As Long r = Asc(UCase(b)) If r > 64& Then subncdec = r - 55& Else subncdec = CLng(b) End If End Function Public Function getXMLPost(url As String, param As String) As Object Dim objXML As Object 'サイトデータの格納先 Dim objDoc As Object 'ドキュメントの格納先 'XMLHTTPオブジェクトを生成 Set objXML = CreateObject("MSXML2.XMLHTTP") 'On Error Resume Next Call objXML.Open("POST", url, False) Call objXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded") Call objXML.send(param) 'ロード完了まで待つ Do While objXML.readyState <> 4 Sleep 100 DoEvents Loop 'DOM操作を行える様にする Set objDoc = CreateObject("MSXML2.DOMDocument") objDoc.LoadXML objXML.responseText Set getXMLPost = objDoc End Function
全部コピペして、キーを入力すれば動作すると思います。
詳しく知りたい方はぜひ読み進めてください。
事前準備
まずは開発者として申請し、Amazonからアクセスキーを発行してもらう必要があります。
取得の方法ついては、たくさん情報があるので調べてみてください。
ちなみに現在は審査に時間がかかるらしく、1、2ヶ月ほど待たされる場合もあるそうです…
開発したいと考えているかたは早めに申請しておくことをおすすめします。
このブログでは、MWS API を使用するためのアクセスキーを取得していることを前提として書いていきます。
参考情報
Amazonの公式サイトで開発者のためのドキュメントがあります。
ぜひ参考にしてみてください。
Amazon MWS 開発者ガイド
Amazon MWSスクラッチパッド
基本的にはここに全部書いてあるんです。
だったらこんな記事いらないんじゃ・・・
と、思われるかもしれませんが開発者ガイドは正直見にくいと感じます。
だから割とMWSの記事を書いてる人多いのかなーと思います。
あとVBAのドキュメントはありません。
Excelの事前準備
3つの入力欄を作り、「認証」ボタンを配置する
新規でExcelファイルを作り、下記のようにアクセスキー等の入力欄を設けます。
個人で使用する分にはExcelに秘密キーとかをベタ書きしても大丈夫でしょう。
入力欄について説明していきますね。
・Seller_ID:Amazonの出品者IDです。
『セラーセントラル』 >『 設定』 > 『出品用アカウント情報』 > 出品者情報欄の>『あなたの出品者トークン』から確認できます。
MWS開発者IDではないので注意!
・アクセスキー:審査が通ると発行されるMWSへのアクセスキー。
『セラーセントラル』 >『 設定』 > 『ユーザー権限』 > 画面下部の『開発者認証情報を表示』から確認できます。
・秘密キー:同じく審査が通ると発行されるMWSへの秘密キー。
こちらもアクセスキーと同じところで確認可能です。
上記3つは人によって違うのでExcelに入力してください。
その値を使ってhttpリクエストを送り、MWS APIから情報を取得します。
VBAコードの記述
順番に解説しながらコードを載せていきます。
「認証」ボタンが押されたら、入力された値で接続できるかチェックする処理です。
認証ボタンクリック時処理
Option Explicit Private Sub BTN_認証_Click() Dim param As String Dim paramToSign As String Dim sellerId As String Dim accessKey As String Dim seacretKey As String Dim endPoint As String Dim marketPlaceId As String Dim timeStamp As String Dim apiVersion As String Dim country As String Dim sign As String Dim url As String Dim xml As Object Dim objSeller As Object Dim objErr As Object Dim wkObj As Object Dim errMsg As String 'パラメータの取得 sellerId = Range("B1").Value accessKey = Range("B2").Value seacretKey = Range("B3").Value country = "JP" If country = "JP" Then '日本 endPoint = "mws.amazonservices.jp" marketPlaceId = "A1VC38T7YXB528" url = "https://mws.amazonservices.jp/Sellers/2011-07-01" ElseIf country = "US" Then 'アメリカ endPoint = "mws.amazonservices.com" marketPlaceId = "ATVPDKIKX0DER" url = "https://mws.amazonservices.com/Sellers/2011-07-01" End If timeStamp = Format(CDate(DateAdd("h", -9, Now)), "yyyy-mm-dd") & "T" & Format(CDate(DateAdd("h", -9, Time)), "hh%3AMM%3Ass") & "Z" apiVersion = "2011-07-01" ' リクエストを作成(パラメータはアルファベット順なので順番を変えるとNG) param = "AWSAccessKeyId=" & accessKey _ & "&Action=ListMarketplaceParticipations" _ & "&SellerId=" & sellerId _ & "&SignatureMethod=HmacSHA256" _ & "&SignatureVersion=2" _ & "&Timestamp=" & timeStamp _ & "&Version=" & apiVersion 'Signatureの取得 paramToSign = "POST" & vbLf & endPoint & vbLf & "/Sellers/2011-07-01" & vbLf & param sign = GetSign(seacretKey, paramToSign) param = param & "&Signature=" & sign '結果XMLを取得 Set xml = getXMLPost(url, param) Set objSeller = xml.SelectNodes("ListMarketplaceParticipationsResponse") If objSeller.Length > 0 Then '取得できていれば接続成功! MsgBox "認証完了", vbInformation Else '取得できなければエラーなので、エラー内容を取得して表示 Set objErr = xml.SelectNodes("ErrorResponse/Error") If objErr.Length > 0 Then Set wkObj = objErr(0).SelectSingleNode("Message") If Not wkObj Is Nothing Then errMsg = wkObj.text End If End If MsgBox "認証失敗" & vbCrLf & errMsg, vbCritical End If End Sub
Excelの入力欄からパラメータの取得
共通の必須パラメータはこちら
docs.developer.amazonservices.com
'パラメータの取得 sellerId = Range("B1").Value accessKey = Range("B2").Value seacretKey = Range("B3").Value country = "JP"
Excelに入力されている各キーを変数に代入。
country = "US"
にすればアメリカのMWS APIに接続できる・・・はず。取得していないので試したことはないです・・・
他のパラメータのセット
If country = "JP" Then '日本 endPoint = "mws.amazonservices.jp" marketPlaceId = "A1VC38T7YXB528" url = "https://mws.amazonservices.jp/Sellers/2011-07-01" ElseIf country = "US" Then 'アメリカ endPoint = "mws.amazonservices.com" marketPlaceId = "ATVPDKIKX0DER" url = "https://mws.amazonservices.com/Sellers/2011-07-01" End If timeStamp = Format(CDate(DateAdd("h", -9, Now)), "yyyy-mm-dd") & "T" & Format(CDate(DateAdd("h", -9, Time)), "hh%3AMM%3Ass") & "Z" apiVersion = "2011-07-01"
今回は日本のMWS APIに接続するので、JPのほうを見ていきます。
・endPoint:エンドポイント。接続先の国によって変更が必要です。
・marketPlaceId:こちらも国ごとに固定。対応表は下記から。
Amazon MWS エンドポイントおよびMarketplaceId
・url:接続先のURLです。
・timeStamp:現在の日時。
日本ではなくアメリカの時刻になります。 なので時差である-9時間してやる必要があります。
・apiVersion:使用するAPIのバージョンです。
AmazonのドキュメントのAPIリファレンスで確認してください。
セットした情報を使ってリクエストを作成
' リクエストを作成(パラメータはアルファベット順なので順番を変えるとNG) param = "AWSAccessKeyId=" & accessKey _ & "&Action=ListMarketplaceParticipations" _ & "&SellerId=" & sellerId _ & "&SignatureMethod=HmacSHA256" _ & "&SignatureVersion=2" _ & "&Timestamp=" & timeStamp _ & "&Version=" & apiVersion
このようにパラメータ名と値を"="で結合し、"&"でつなぐ。
まだ解説していないパラメーターについて説明
・Action:実行したいアクションを指定します。
今回は出品者情報を取得するので、ListMarketplaceParticipationsを指定。
・SignatureMethod:署名の計算方法。なにも考えずに「HmacSHA256」を指定してください。
・SignatureVersion:署名のバージョン。何も考えずに「2」を指定してください。
署名に関しては次で解説
署名
'Signatureの取得 paramToSign = "POST" & vbLf & endPoint & vbLf & "/Sellers/2011-07-01" & vbLf & param sign = GetSign(seacretKey, paramToSign) param = param & "&Signature=" & sign
上記で作成したパラメータを暗号化して、Signatureを作成します。
この辺が訳わかんなくなるところじゃないでしょうか?
暗号化?Signature??
正直私もこのへん詳しくないですが、暗号化の仕方は調べればたくさん出てきます。
標準モジュールを新しく追加して、下記コードを貼りつけてください。
標準モジュール:hash
'advapi32.dll 'http://su-u.jp/juju/%B5%A4%A4%DE%A4%B0%A4%EC%C6%FC%B5%AD/2007-03-08.html Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _ (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _ ByVal dwProvType As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptReleaseContext Lib "advapi32.dll" _ (ByVal hProv As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptCreateHash Lib "advapi32.dll" _ (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _ ByRef phHash As Long) As Long Private Declare Function CryptDestroyHash Lib "advapi32.dll" _ (ByVal hHash As Long) As Long Private Declare Function CryptHashData Lib "advapi32.dll" _ (ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptGetHashParam Lib "advapi32.dll" _ (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _ ByVal dwFlags As Long) As Long Private Const PROV_RSA_FULL As Long = 1 Private Const PROV_RSA_AES As Long = 24 Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000 Private Const HP_HASHVAL As Long = 2 Private Const HP_HASHSIZE As Long = 4 Private Const ALG_TYPE_ANY As Long = 0 Private Const ALG_CLASS_HASH As Long = 32768 Private Const ALG_SID_MD2 As Long = 1 Private Const ALG_SID_MD4 As Long = 2 Private Const ALG_SID_MD5 As Long = 3 Private Const ALG_SID_SHA As Long = 4 Private Const ALG_SID_SHA_256 As Long = 12 Private Const ALG_SID_SHA_384 As Long = 13 Private Const ALG_SID_SHA_512 As Long = 14 Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2) Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4) Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5) Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA) Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256) Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384) Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512) ' Create Hash Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String Dim hProv As Long, hHash As Long Dim abytHash(0 To 63) As Byte Dim lngLength As Long Dim lngResult As Long Dim strHash As String Dim i As Long strHash = "" If CryptAcquireContext(hProv, vbNullString, vbNullString, _ IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _ CRYPT_VERIFYCONTEXT) <> 0& Then If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then lngLength = UBound(abytData()) - LBound(abytData()) + 1 If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _ Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&) If lngResult <> 0& Then lngLength = UBound(abytHash()) - LBound(abytHash()) + 1 If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then For i = 0 To lngLength - 1 strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2) Next End If End If CryptDestroyHash hHash End If CryptReleaseContext hProv, 0& End If CreateHash = LCase$(strHash) End Function ' Create Hash From String(Shift_JIS) Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID) End Function ' Create Hash From File Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String Dim abytData() As Byte Dim intFile As Integer Dim lngError As Long On Error Resume Next If Len(Dir(strFileName)) > 0 Then intFile = FreeFile Open strFileName For Binary Access Read Shared As #intFile abytData() = InputB(LOF(intFile), #intFile) Close #intFile End If lngError = Err.Number On Error GoTo 0 If lngError = 0 Then CreateHashFile = CreateHash(abytData(), lngAlgID) _ Else CreateHashFile = "" End Function ' MD5 Public Function CreateMD5Hash(abytData() As Byte) As String CreateMD5Hash = CreateHash(abytData(), CALG_MD5) End Function Public Function CreateMD5HashString(ByVal strData As String) As String CreateMD5HashString = CreateHashString(strData, CALG_MD5) End Function Public Function CreateMD5HashFile(ByVal strFileName As String) As String CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5) End Function ' SHA-1 Public Function CreateSHA1Hash(abytData() As Byte) As String CreateSHA1Hash = CreateHash(abytData(), CALG_SHA) End Function Public Function CreateSHA1HashString(ByVal strData As String) As String CreateSHA1HashString = CreateHashString(strData, CALG_SHA) End Function Public Function CreateSHA1HashFile(ByVal strFileName As String) As String CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA) End Function ' SHA-256 Public Function CreateSHA256Hash(abytData() As Byte) As String CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256) End Function Public Function CreateSHA256HashString(ByVal strData As String) As String CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256) End Function Public Function CreateSHA256HashFile(ByVal strFileName As String) As String CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256) End Function ' SHA-384 Public Function CreateSHA384Hash(abytData() As Byte) As String CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384) End Function Public Function CreateSHA384HashString(ByVal strData As String) As String CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384) End Function Public Function CreateSHA384HashFile(ByVal strFileName As String) As String CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384) End Function ' SHA-512 Public Function CreateSHA512Hash(abytData() As Byte) As String CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512) End Function Public Function CreateSHA512HashString(ByVal strData As String) As String CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512) End Function Public Function CreateSHA512HashFile(ByVal strFileName As String) As String CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512) End Function
標準モジュール:common
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Hmac-SHA256 'http://plus-sys.jugem.jp/?eid=215 Public Function GetSign(sKey, rawTextToSign As String) As String Dim arKey() As Byte Dim ipad As String Dim opad As String Dim hash, hash_2, hash_cut2, hash_10, hash_cut10 As String Dim buff() As Byte, offset As Integer Dim sign As String Dim base64Array As Variant '初期化 ipad = "" opad = "" hash = "" ReDim arKey(0 To 63) '秘密鍵から1文字づつ読込み、文字コードへ変換後配列へ格納 For i = 0 To Len(sKey) - 1 arKey(i) = Asc(Mid(sKey, i + 1, 1)) Next '64文字に満たない分は、ゼロセット For i = Len(sKey) To 63 arKey(i) = 0 Next 'innerpad及びouterpad作成 For i = 0 To 63 ipad = ipad & Chr(arKey(i) Xor &H36) opad = opad & Chr(arKey(i) Xor &H5C) Next 'ハッシュ処理1回目 '(innerpad+メッセージ文字列)をハッシュ・・・ハッシュ結果1 hash = CreateSHA256HashString(ipad & rawTextToSign) 'ハッシュ処理2回目 buff = StrConv(opad, vbFromUnicode) offset = UBound(buff) ReDim Preserve buff(offset + Len(hash) \ 2) For i = 1 To (Len(hash) \ 2) buff(offset + i) = CByte("&H" & Mid(hash, (i - 1) * 2 + 1, 2)) Next hash = CreateSHA256Hash(buff) '2進数に変換 hash_2 = "" For k = 1 To 64 Step 2 hash_cut2 = Mid(hash, k, 2) hash_2 = hash_2 & HEX2BIN(hash_cut2) Next '不足が出るので00で埋める hash_2 = hash_2 & "00" 'BASE64エンコード sign = "" For k = 1 To 256 Step 6 hash_cut10 = Mid(hash_2, k, 6) hash_10 = ncdec(2, hash_cut10) base64Array = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/") sign = sign & base64Array(hash_10) Next '不足が出るので=で埋める sign = sign & "=" 'URLエンコード sign = UrlEncode(sign) GetSign = sign End Function Function StrHex(text As String) As String Dim lCount As Long Dim sResult As String Dim lLength As Long lLength = Len(text) For lCount = 1 To lLength Step 2 sResult = sResult & Chr(Val("&H" & Mid(text, lCount, 2))) Next StrHex = sResult End Function 'URL エンコード 'http://www.geocities.co.jp/SilkRoad/4511/vb/urlenc.htm Public Function UrlEncode(ByRef strSource As String) As String Dim lngLength As Long '文字列のサイズ(S-JIS 変換後)を格納する Dim bytSource() As Byte 'ANSI/S-JIS に変換した文字列を格納するバイト型配列 Dim strBuffer As String 'URL エンコードされた文字列を一時格納するバッファ Dim bytSingle As Byte '配列から抜き出した 1 バイトを格納する Dim strSingleHex As String '文字コードを 16 進化した文字列を格納する Dim lngReadCount As Long 'bytSource 読み込み位置カウンタ Dim lngWriteCount As Long 'strBuffer 書き込み位置カウンタ lngLength = LenB(StrConv(strSource, vbFromUnicode)) 'ANSI/S-JIS 変換後のサイズを求める If Not CBool(lngLength) Then Exit Function '0 バイトの場合関数を抜ける ReDim bytSource(lngLength - 1) 'ANSI/S-JIS 変換文字列を格納する領域を確保 bytSource = StrConv(strSource, vbFromUnicode) 'ANSI/S-JIS に変換し bytSource に格納 strBuffer = String$(lngLength * 3, vbNullChar) 'URL エンコード文字列一時格納バッファを確保 strSingleHex = "%00" '16 進化した文字コードを格納するバッファを確保 lngWriteCount = 1 '書き込みカウンタは 1 から開始 Do '文字列の終端までループ bytSingle = bytSource(lngReadCount) '配列から 1 バイト抜く(毎回参照するより速い?) If ((bytSingle >= &H81) And (bytSingle <= &H9F)) Or _ ((bytSingle >= &HE0) And (bytSingle <= &HEF)) Then 'Shift-JIS 2 バイト文字と確認された場合 Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換(上位バイト) Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす If lngReadCount = lngLength Then Exit Do '文字列の終端に達した場合、ループを抜ける bytSingle = bytSource(lngReadCount) '配列から 1 バイト抜く Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換(下位バイト) Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす ElseIf bytSingle = &H20 Then '半角スペース文字(" ")の場合 Mid(strBuffer, lngWriteCount, 1) = "+" '"+" を代わりに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 1 '書き込みカウンタを 1 増やす ElseIf ((bytSingle >= &H40) And (bytSingle <= &H5A)) Or _ ((bytSingle >= &H61) And (bytSingle <= &H7A)) Or _ ((bytSingle >= &H30) And (bytSingle <= &H39)) Or _ (bytSingle = &H2A) Or _ (bytSingle = &H2D) Or _ (bytSingle = &H2E) Or _ (bytSingle = &H5F) Then '無変換文字であった場合 Mid(strBuffer, lngWriteCount, 1) = Chr$(bytSingle) '文字コードを文字列に戻して書き込む(^^; lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 1 '書き込みカウンタを 1 増やす Else 'その他の文字の場合 If bytSingle <= &HF Then 'Hex$() の結果が 1 文字になる場合 Mid(strSingleHex, 2, 1) = "0" '0 を先頭に付加 Mid(strSingleHex, 3, 1) = Hex$(bytSingle) '文字コードを 16 進数に変換 Else '0 を付加する必要がない場合 Mid(strSingleHex, 2, 2) = Hex$(bytSingle) '文字コードを 16 進数に変換 End If Mid(strBuffer, lngWriteCount, 3) = strSingleHex 'URL エンコードされた文字列をバッファに書き込む lngReadCount = lngReadCount + 1 '読み込みカウンタをインクリメント lngWriteCount = lngWriteCount + 3 '書き込みカウンタを 3 増やす End If Loop Until lngReadCount = lngLength Erase bytSource 'バイト型配列を消去 If lngWriteCount > 1 Then 'バッファに文字列が書き込まれた場合 UrlEncode = Left$(strBuffer, lngWriteCount - 1) 'バッファの余分な部分を削り、戻り値とする End If End Function Public Function HEX2BIN(ByVal hx As String) As String Dim num As Long Dim bin As String Dim i As Integer num = CLng("&H" & hx) For i = Len(hx) * 4 - 1 To 0 Step -1 bin = bin & -CLng((num And (2 ^ i)) <> 0) Next HEX2BIN = bin End Function 'n進数の文字列strNumberを10進数の数字に変換して返す 'http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/Convert.htm Public Function ncdec(ByVal n As Long, ByVal strNumber As String) As Long Dim lngt As Long Dim c As Long Dim i As Long lngt = 0& c = 1& For i = 1& To Len(strNumber) lngt = lngt + subncdec(Left$(Right$(strNumber, i), 1)) * c c = c * n Next i ncdec = lngt End Function Public Function subncdec(ByVal b As String) As Long Dim r As Long r = Asc(UCase(b)) If r > 64& Then subncdec = r - 55& Else subncdec = CLng(b) End If End Function Public Function getXMLPost(url As String, param As String) As Object Dim objXML As Object 'サイトデータの格納先 Dim objDoc As Object 'ドキュメントの格納先 'XMLHTTPオブジェクトを生成 Set objXML = CreateObject("MSXML2.XMLHTTP") 'On Error Resume Next Call objXML.Open("POST", url, False) Call objXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded") Call objXML.send(param) 'ロード完了まで待つ Do While objXML.readyState <> 4 Sleep 100 DoEvents Loop 'DOM操作を行える様にする Set objDoc = CreateObject("MSXML2.DOMDocument") objDoc.LoadXML objXML.responseText Set getXMLPost = objDoc End Function
めんどくさそうですが、VBAで新しい標準モジュールを2つ作成して、
上記ソースコードを張り付ければOKです。
まずは"接続できた!"、という成功体験をすることが大事だと私は思います。
ではメインのソースコードに戻ってラストスパートです。
結果XMLの取得
'結果XMLを取得 Set xml = getXMLPost(url, param) Set objSeller = xml.SelectNodes("ListMarketplaceParticipationsResponse") If objSeller.Length > 0 Then '取得できていれば接続成功! MsgBox "認証完了", vbInformation Else '取得できなければエラーなので、エラー内容を取得して表示 Set objErr = xml.SelectNodes("ErrorResponse/Error") If objErr.Length > 0 Then Set wkObj = objErr(0).SelectSingleNode("Message") If Not wkObj Is Nothing Then errMsg = wkObj.text End If End If MsgBox "認証失敗" & vbCrLf & errMsg, vbCritical End If
リクエストの結果はXMLで帰ってくるので、オブジェクトで受け取ります。
この辺からAmazonスクラッチパッドが役に立ってきます。
せっかくなので使ってみましょうか。
Amazonスクラッチパッドの使い方
成功すると私のキーが出てしまうので、入力を間違えてエラーが出た場合のものを載せました。
成功した場合はご自身で確かめてみてください。
ここで見るべきところは、レスポンスと書かれている枠の中のコードです。
これが取得結果です。
今回はエラーなのでErrorResponse
のタグで始まるコードが返ってきますが、
成功するとListMarketplaceParticipationsResponse
のタグで始まるコードが返ってくるはずです。
確認してみてください。
上記のコードではSet xml = getXMLPost(url, param)
で取ってきているので、
Set objSeller = xml.SelectNodes("ListMarketplaceParticipationsResponse")
で、そのタグを取得しています。
これで取得できれば成功ですし、取得できなければエラーが返ってきている、というわけです。
成功ならば「認証完了!」とメッセージが返ってきます。
xmlから欲しい情報の取得に関してはまた後日記事にしましょうかね・・・
そんな難しいものではないのですが、既にかなり長くなってしまいましたし・・・
まとめ
いかがでしたでしょうか?
思ったよりもかなり長くなってしまいました・・・
もし分からないところがあったらコメントやTwitterでメッセージください!