ゆゆのExcelVBA覚書-副業から独立-

現役社内SEがExcel VBAを中心に覚書として書いていくブログです。

トップ > Amazon欧米輸入 > 【MWS API】まずは接続してみよう！【Excel VBA】

【MWS API】まずは接続してみよう！【Excel VBA】

Amazon欧米輸入 Excel VBA

Hatena

はじめに

ではAmazon MWS API を使用して商品情報を取得する方法について、書いていきたいと思います。

その前にまずは接続確認をしてみましょう！
 

簡単なパラメータを送信して、ちゃんと返ってくるか。 これができなければ始まりません。

恐らく一番難しいところです。
接続さえできてしまえばあとはどのパラメータを渡すかだけなので…


がんばっていきましょう！
※Excel VBAがある程度できることを前提として書きます。

 

Excel VBAでMWS APIの接続確認をする方法

結論から先に載せます。
いきなり長い記述になってしまいますが、あとで解説するので分からない方はそのまま読み進めてください！

f:id:yumeigunshi444:20190904124710p:plain
アクセスキーなどを入力するシートと認証ボタン
認証ボタンクリック時処理

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スクラッチパッド

基本的にはここに全部書いてあるんです。

だったらこんな記事いらないんじゃ・・・

と、思われるかもしれませんが開発者ガイドは正直見にくいと感じます。
 

だから割とＭＷＳの記事を書いてる人多いのかなーと思います。

 

あとＶＢＡのドキュメントはありません。

 

Excelの事前準備

３つの入力欄を作り、「認証」ボタンを配置する

新規でExcelファイルを作り、下記のようにアクセスキー等の入力欄を設けます。

個人で使用する分にはExcelに秘密キーとかをベタ書きしても大丈夫でしょう。 f:id:yumeigunshi444:20190904124710p:plain

入力欄について説明していきますね。

 

・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：接続先のＵＲＬです。
・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で新しい標準モジュールを２つ作成して、
上記ソースコードを張り付ければＯＫです。

まずは"接続できた!"、という成功体験をすることが大事だと私は思います。


ではメインのソースコードに戻ってラストスパートです。

結果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スクラッチパッドの使い方

f:id:yumeigunshi444:20190831174945p:plain
エラーの場合
今回のケースを元に入力してみました。
成功すると私のキーが出てしまうので、入力を間違えてエラーが出た場合のものを載せました。

成功した場合はご自身で確かめてみてください。

ここで見るべきところは、レスポンスと書かれている枠の中のコードです。
これが取得結果です。

今回はエラーなのでErrorResponseのタグで始まるコードが返ってきますが、
成功するとListMarketplaceParticipationsResponseのタグで始まるコードが返ってくるはずです。
確認してみてください。

上記のコードではSet xml = getXMLPost(url, param)で取ってきているので、
Set objSeller = xml.SelectNodes("ListMarketplaceParticipationsResponse") で、そのタグを取得しています。

これで取得できれば成功ですし、取得できなければエラーが返ってきている、というわけです。
f:id:yumeigunshi444:20190831180707p:plain
出品者IDが間違っている場合
そしてエラーの場合はこのようにメッセージが返ってきます。

成功ならば「認証完了！」とメッセージが返ってきます。


xmlから欲しい情報の取得に関してはまた後日記事にしましょうかね・・・
そんな難しいものではないのですが、既にかなり長くなってしまいましたし・・・

まとめ

いかがでしたでしょうか？

思ったよりもかなり長くなってしまいました・・・

もし分からないところがあったらコメントやTwitterでメッセージください！