こんにちは。てちてちエンジニアのおっとーです。
突然ですが、
最近せどりや転売などが流行っているのか、
「リサーチツール」や「在庫管理ツール」の需要が高まっている気がします。
私も知人からせどりを始めたから在庫管理ができる仕組みを作って欲しいと言われ、
お手伝いする中で楽天RMSのドキュメントがわかりづらく、
参考になるサイトも少なかったので記事にして残そうかと思いました。
個人事業主・中小企業では
- 大規模システムの導入はコストに見合わない
- Excelで受発注管理している
- Excelで在庫管理している
まだまだこんなことあるんじゃないでしょうか。
でも、在庫確認のような毎日の作業となると、
可能な限り「自動化したい！」と思いますよね。
そこで今回はその第一歩としてExcelVBAでRMSのAPIから、
商品の在庫数を取得するコードを紹介していこうかと思います。
コード
在庫取得の雛形コードは以下になります。
特に詳細説明いらない方はコピペして活用してあげてください。
追加で参照が必要なライブラリは、こちらです。
- Microsoft Scripting Runtime
- Microsoft XML, v6.0
- mscorlib.dll
Sub 在庫確認()
'※大文字の変数に関して※
'コピペで使用できるように変数としていますが、実際にツールを作る際には定数として管理してください。
Dim STORE_NAME As String
Dim STORE_URL As String
Dim SERVICE_SEC As String
Dim LISENCE_KEY As String
Dim ENDPOINT As String
'楽天API設定項目
STORE_NAME = "ストア名を記入(任意)"
STORE_URL = "ストアURLを記入(任意)"
SERVICE_SEC = "サービスシークレット(必須)"
LISENCE_KEY = "ライセンスキー(必須)"
ENDPOINT = "https://api.rms.rakuten.co.jp/es/1.0/inventory/ws"
Dim httpReq As Object
Dim dom As Object
Dim encoding As Object
Dim items As String '商品番号管理用
Dim itemlist() As String '商品番号管理用
Dim i As Long '商品番号管理用
Dim stringList As String 'XML構成用
Dim body As Variant 'リクエスト時のBody
Dim authKey() As Byte '認証情報
Dim strAuth As String '整形済み認証情報
Dim elements As Object '取得情報解析用
Dim element As Object '取得情報解析用
Dim details As Object '取得情報解析用
Dim detail As Object '取得情報解析用
Dim itemName As String '取得情報解析用
Dim stockCount As Long '取得情報解析用
'Objectの初期化
Set httpReq = New XMLHTTP60
Set dom = New DOMDocument60
Set encoding = New UTF8Encoding
'商品A~Eは仮のアイテムです
'実際の商品番号に修正しループ処理できるような形式でitemlistに代入してください。
items = "商品A,商品B,商品C"
itemlist = Split(items, ",")
'APIリクエストitemUrlの中身を初期化
stringList = ""
'【<string>アイテム名</string>】の形式で在庫確認するアイテムをリストアップ
For i = 0 To UBound(itemlist)
stringList = stringList & "<string>" & itemlist(i) & "</string>"
Next i
'認証情報の処理
authKey = encoding.GetBytes_4(SERVICE_SEC & ":" & LISENCE_KEY)
With dom
.LoadXML ("<root />")
.DocumentElement.dataType = "bin.base64"
.DocumentElement.nodeTypedValue = authKey
End With
strAuth = "ESA " & Replace(dom.DocumentElement.text, vbLf, "")
'Xmlの構成
body = "<soapenv:Envelope" & vbNewLine _
& "xmlns:soapenv=" & Chr(34) & "https//schemas.xmlsoap.org/soap/envelope/" & Chr(34) & vbNewLine _
& "xmlns:ws=" & Chr(34) & "https://api.rms.rakuten.co.jp/es/1.0/inventory/ws" & Chr(34) & ">" & vbNewLine _
& "<soapenv:Body>" & vbNewLine _
& "<ws:getInventoryExternal>" & vbNewLine _
& "<externalUserAuthModel>" & vbNewLine _
& "<authKey>" & strAuth & "</authKey>" & vbNewLine _
& "<userName>" & STORE_NAME & "</userName>" & vbNewLine _
& "<shopUrl>" & STORE_URL & "</shopUrl>" & vbNewLine _
& "</externalUserAuthModel>" & vbNewLine _
& "<getRequestExternalModel>" & vbNewLine _
& "<itemUrl>" & stringList & "</itemUrl>" & vbNewLine _
& "</getRequestExternalModel>" & vbNewLine _
& "</ws:getInventoryExternal>" & vbNewLine _
& "</soapenv:Body>" & vbNewLine _
& "</soapenv:Envelope>"
'リクエスト準備
httpReq.Open "POST", ENDPOINT, False
'ヘッダーの設定
httpReq.setRequestHeader "Accept-Encoding", "gzip,deflate"
httpReq.setRequestHeader "Content-Type", "text/xml;charset=UTF-8"
'bodyにxmlをもたせてリクエスト
httpReq.send (body)
'API応答待ち(4=応答)
Do While httpReq.readyState < 4
DoEvents
Loop
'正常に終了した場合
If InStr(httpReq.responseXML.text, "正常終了") > 0 Then
dom.LoadXML (httpReq.responseText)
Else
MsgBox "エラーが発生しています"
Exit Sub
End If
'正常に在庫数取得が完了した場合XMLデータを解析していく
Set elements = dom.getElementsByTagName("n2:GetResponseExternalItem")
For Each element In elements
itemName = ""
stockCount = 0
If element.ChildNodes(3).BaseName = "itemUrl" Then
itemName = element.ChildNodes(3).text
Else
MsgBox "商品名が見つかりません。" & vbCrLf & "処理を中断します。"
Exit Sub
End If
Set details = element.ChildNodes(0).ChildNodes(0)
For Each detail In details.ChildNodes
If detail.BaseName = "inventoryCount" Then
stockCount = detail.text
Debug.Print (itemName & ":" & stockCount)
Exit For
End If
Next detail
Next element
'オブジェクト解放
Set httpReq = Nothing
Set dom = Nothing
Set encoding = Nothing
End Sub
コメント