　「amazonの情報を署名付きで取得するサンプル・VBAコード（EXCEL図書管理）」

戻る

EXCEL図書管理.xlsでは、新規図書の登録の際に、amazonから情報を取得していました。
AWSの仕様が変わり、2009/8月からは署名付きでないとアクセスできなくなりました。署名付きのVBAコードが、MASさんのホームページでサンプルとして掲載されていましたので、大いに参考にさせていただき、EXCEL図書管理のVBAコードを修正できたように思いますので、掲載します。「思います」の意味は、余りテストしていないということです。8冊10桁ISBN、13桁ISBNで情報取得は出来ました。
なお、MASさんのホームページのサンプルにもありますように、DLLが必要です。EXCEL図書管理と同じフォルダーにsign.dllを保管しておいてください。

利用にあたっては、AWS利用規約をよくお読みいただくことと、AWSAccessKeyIdとSecretKeyを利用者が各自取得しVBA内のコードをご自身のkeyに書き換える必要があります。　なお、SecretKeyは他人に知らせない・知られてはいけないとのことです。
VBA保存で、表示パスワードを設定しての運用か、他者に当ブックを渡す場合はパスワードを消してから渡すようにするのが好ましいと思われます。
xlのパスワードは時間を掛ければ解析されるようです。できるだけ長いものおよび英数字記号が入ったものが好ましいと言われています。
2007年現在で、16桁で解析2カ月と言われています。ですので、20桁もしくは30桁ぐらいが妥当でしょうか（ぉ
長い文章をローマ字入力して作ると何かと覚えやすいかもしれません。　<ご参考>　pass解析　 password解析速度一覧
例：mynamaeisneko_adgopu:jlakjrgepjah;ohe098345h3; （汗

keyの取得は、こちら。　※AWSのアカウントを取得していない場合は、まずAWSアカウントの取得から行います。
key取得の説明は、こちらにあります。

EXCEL図書管理.xlsでは、「図書の新規登録」の一括処理シート上のボタンにマクロを関連づけているのと、
保守管理フォームのなかの、新規図書の登録タブ上のボタンに関連づけているものがあります。

現状のxlsのVBA該当モジュールを入れ替えると、動作すると思われる。
なお、モジュールのそれぞれのマクロ名は変更していない。

Sub Amazonから図書情報を取得()
' http://www.microstory.org/gakusi/wiki/ExcelAWSMemo.html 参照。
'　　松本楽志（がくし）の天使の階段より。
'　GetBookInfoFromAmazon()をengiが変更（説明追加）したものです。
'　http://www2u.biglobe.ne.jp/~MAS/hoka/excelamazon.html
'　MASさんのページ参照
'　コメントは、基本コメント行の上の構文について付けています。

'　「図書の新規登録」の一括処理シートにて利用。

Dim Res
Res = MsgBox("ISBN番号を元に、amazon.co.jpから、図書情報を取得します。" & vbCrLf & _
"インターネットに接続できている必要があります。" & vbCrLf & _
"B列～G列までのセルは上書きされます。", vbOKCancel, "amazon.webｻｰﾋﾞｽの利用byMASさん")
If Res = vbCancel Then Exit Sub

Dim Url As String
Dim xmldata As Object
Dim Author As Object
Dim i As Integer
Dim J As Long
Dim K As Long
Dim Atai As Long
Dim ItemAttributes As Object
Dim Asin As String
Dim rowIndex As Integer
Dim item As Object
Dim SignedUrl As String
Dim keyid As String '　<--追加(engi)
Dim SecretKey As String

'　rowIndex = ActiveCell.Row
keyid = "***********************" '　<--　変更(自身のKEYIDを入れる。)
SecretKey = "***********************************" '　< --自身のSecretkeyを入れる｡

'　動作を確認したら、プロジェクトウインドウの標準モジュール＝Amazon2excel上で右クリックして、
'　保護タブ～プロジェクト表示用のパスワードを入力すること。
'　パスワードの文字の長さは13ケタ以上～長ければ長いほどよい～にすること。
ChDrive ActiveWorkbook.path
ChDir ActiveWorkbook.path

rowIndex = 10 '　10行目を固定行とする。

While ActiveSheet.Cells(rowIndex, 1) <> ""
'　A5セルから下方向に連続して処理をする。A列のセル値が空白の場合は処理を終了する。

Asin = ActiveSheet.Cells(rowIndex, 1).Value
'　　Url生成で、IdType=ISBNを指定しなかった場合は、下記の13桁を10桁に変換する処理必要。
' If Len(Asin) = 13 Then ' ISBN13桁の場合は10桁に変換する。
' Atai = 0
' K = 10
' For J = 1 To 9
' Atai = Val(Mid(Asin, J + 3, 1)) * K + Atai
' K = K - 1
' Next
' Atai = Atai Mod 11
' Atai = 11 - Atai
' Asin = Mid(Asin, 4, 9) & Atai
' End If

' △ Url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&AWSAccessKeyId=" & keyid & "&Operation=ItemLookup&ResponseGroup=Medium&Version=2009-03-31&ItemId=" & Asin
'　↑だと13桁isbnコードが検索対象とならない。10桁keyだと大丈夫。13桁を10桁に変換するとOK。
' × Url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&AWSAccessKeyId=" & keyid & "&Operation=ItemLookup&IdType=ISBN&SearchIndex=Books&ResponseGroup=Request,Large&Version=2009-03-31&ItemId=" & Asin
'　エラー？
Url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&AWSAccessKeyId=" & keyid & "&Operation=ItemLookup&IdType=ISBN&SearchIndex=Books&ResponseGroup=Medium&Version=2009-03-31&ItemId=" & Asin

' 署名をつける
SignedUrl = String(Len(Url) + 100, vbNullChar)
Call UrlSign(Url, SignedUrl, SecretKey)
SignedUrl = Left(SignedUrl, InStr(SignedUrl, vbNullChar) - 1)

' src = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&AWSAccessKeyId=" & keyid & "&Operation=ItemLookup&IdType=ISBN&SearchIndex=Books&ResponseGroup=Request,Large&ItemId=" & Asin
'　http://www.ajaxtower.jp/ecs/itemsearch/index2.html　参照。
'　http～は、WEBのアドレス欄に入力すると指定したdataが表示されるはず！？
'　srcで、amazon.co.jpへのリクエストを定義。実行するのは、下のxml.loadにて。
' API実行
Set xmldata = CreateObject("Microsoft.XMLDOM")
xmldata.async = False
'　Async プロパティを False に設定すると、ドキュメントが完全に読み込まれて
'　処理の準備が整うまで、パーサーはコードにコントロールを返しません。
'
'　http://itpro.nikkeibp.co.jp/article/COLUMN/20070910/281556/より↓引用。
'　「(2)DOMのasyncプロパティにfalseを指定してXMLファイルの読み込みを同期読み込みに
'　します。　asyncプロパティのデフォルトでは，処理したいXMLファイルの読み込みを
'　XMLパーサに要求すると，非同期読み込みになります(true)。非同期読み込みでは，
'　XMLファイルが完全に読み込まれたかどうかに関係なく，パーサは次の処理を実行しようと
'　します。これによってエラーが発生する場合があります。そこでasyncプロパティに
'　falseを指定して同期読み込みとしておく必要があります。」
xmldata.Load SignedUrl
'　変数SignedUrl（署名付きurl）の内容を実行する。
'　つまり、amazon.co.jpのWEBサービスにアクセスし、指定条件のデータを取得する。
'　取得したデータは、XMLDOMの定数に格納される。
'　以下で、XMLDOM-取得データを中で欲しい情報がどのパスにあるかを指定して、エクセルに表示させる。
Set ItemAttributes = xmldata.selectSingleNode("ItemLookupResponse/Items/Item/ItemAttributes")
'　「xml.selectSingleNode」は、XML文書から任意の１ノード(IXMLDOMNode)を取得するメソッド。
'　引数にはXPathで検索条件を指定する｡　XML文書のどの部分にタイトルなどの情報があるかのパスを
'　itemAttributes変数に代入する。　このパスはamazon固有。
'　イメージは、http://ajex2.web.fc2.com/BGExample01.htm#DOM　にあります。

If Not ItemAttributes Is Nothing Then '取得情報があれば、
'著者
Dim authorText As String
authorText = ""
Set Author = ItemAttributes.selectNodes("Author")
'　変数itemAttributesの中のAuthor項目を選択し、その値をauthor変数に代入する。
'　↓は著者項目のブランク対応か？
For i = 0 To Author.Length - 1
authorText = authorText & Author(i).Text
If i <> Author.Length - 1 Then
authorText = authorText & "，"
End If
Next
ActiveSheet.Cells(rowIndex, 3) = authorText

'タイトル
ActiveSheet.Cells(rowIndex, 2) = ItemAttributes.selectSingleNode("Title").Text
'「.selectSingleNode」
'出版社
ActiveSheet.Cells(rowIndex, 4) = ItemAttributes.selectSingleNode("Publisher").Text

'値段　（engiは使わないので,コメントアウトした。）
ActiveSheet.Cells(rowIndex, 7) = ItemAttributes.selectSingleNode("ListPrice/Amount").Text
'　入荷日=I1セル値を代入する。
If ActiveSheet.Cells(rowIndex, 2) <> "" Then ActiveSheet.Cells(rowIndex, 6) = Format(Range("i1").Value, "yyyy/mm/dd")

Else
'　ActiveSheet.Cells(rowIndex, 2) = "●●該当の情報はありません。●●"
'　もし、該当したISBN番号＝asin値がない場合の処理を入れるかどうか。
End If

次へ:
rowIndex = rowIndex + 1
Set xmldata = Nothing
'　amazon.co.jpへのWEBサービスへは、1秒間隔を空けろとのことなので、ウエイト入れる。
'　下記timevalueを0:00:01では場合によりamazonからエラーになるので、0:00:02とした。
'　エラーが出る場合、0:00:03など値を大きくする。
Excel.Application.Wait (Now + TimeValue("0:00:02"))

Wend

MsgBox "amazonから図書データを取得完了。B列～が空白のものは該当データが見つからなかったものです。"

End Sub

Sub Amazon2excelform()

' http://www.microstory.org/gakusi/wiki/ExcelAWSMemo.html から転載。
'　GetBookInfoFromAmazon()をengiが変更（説明追加）したものです。
'　http://www2u.biglobe.ne.jp/~MAS/hoka/excelamazon.html
'　MASさんのページ参照
'　コメントは、基本コメント行の上の構文について付けています。

'　Userform5の新規図書の登録タブにて、使用している。

Dim Url As String
Dim xmldata As Object
Dim Author As Object
Dim i As Integer
Dim ItemAttributes As Object
Dim Asin As String
Dim rowIndex As Integer
Dim item As Object
Dim Syuppan As String
Dim SignedUrl As String
Dim keyid As String '　<--追加(engi)
Dim SecretKey As String

' フォーム5内で入力された値を元に、amazonから情報を取得する。
Application.ScreenUpdating = False
Worksheets("work").Activate

keyid = "****************************" '　<--　変更(自身のKEYIDを入れる。)
SecretKey = "****************************************" '　< --自身のSecretkeyを入れる｡

'　動作を確認したら、プロジェクトウインドウの標準モジュール＝Amazon2excel上で右クリックして、
'　保護タブ～プロジェクト表示用のパスワードを入力すること。
'　パスワードの文字の長さは13ケタ以上～長ければ長いほどよい～にすること。
ChDrive ActiveWorkbook.path
ChDir ActiveWorkbook.path

Asin = UserForm5.TextBox5.Value

Url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&AWSAccessKeyId=" & keyid & "&Operation=ItemLookup&IdType=ISBN&SearchIndex=Books&ResponseGroup=Medium&Version=2009-03-31&ItemId=" & Asin
' 署名をつける
SignedUrl = String(Len(Url) + 100, vbNullChar)
Call UrlSign(Url, SignedUrl, SecretKey)
SignedUrl = Left(SignedUrl, InStr(SignedUrl, vbNullChar) - 1)
' API実行
Set xmldata = CreateObject("Microsoft.XMLDOM")
xmldata.async = False
'　falseを指定して同期読み込みとしておく必要がある。
xmldata.Load SignedUrl
Set ItemAttributes = xmldata.selectSingleNode("ItemLookupResponse/Items/Item/ItemAttributes")

If Not ItemAttributes Is Nothing Then '取得情報があれば、
'著者
Dim authorText As String
authorText = ""
Set Author = ItemAttributes.selectNodes("Author")

For i = 0 To Author.Length - 1
authorText = authorText & Author(i).Text
If i <> Author.Length - 1 Then
authorText = authorText & "，"
End If
Next

UserForm5.TextBox7.Value = authorText

'タイトル
UserForm5.TextBox6.Value = ItemAttributes.selectSingleNode("Title").Text
'「.selectSingleNode」
'出版社 : comboboxは編集可にしておくこと。（userform5のactivateで定義している）
Syuppan = ItemAttributes.selectSingleNode("Publisher").Text
UserForm5.ComboBox1.Value = Syuppan
'値段　（engiは使わないので,コメントアウトした。）
UserForm5.TextBox11.Value = ItemAttributes.selectSingleNode("ListPrice/Amount").Text
End If
Set xml = Nothing
'　amazon.co.jpへのWEBサービスへは、1秒間隔を空けろとのことなので、ウエイト入れる。
Excel.Application.Wait (Now + TimeValue("0:00:02"))
End Sub

戻る