商品リスト関連のVBAを記述する

まず、選択済みの末端カテゴリの商品リスト情報を、ページを引数に指定して取得するプロシージャgetPageを記述します。

[リスト4]プロシージャgetPage

      Private Sub getPage(page As Integer)
          (略)

          '(2)HTTP通信によるリクエスト送信
          url = urlLeaf & "?appid=" & appID & "&category=" & rng.Cells(rowCate, colCateID)
  If Sheets("Sheet3").Range("SortPrice") = True Then url = url & "&sort=cbids"
  If Sheets("Sheet3").Range("SortTime") = True Then url = url & "&sort=end"
  If Sheets("Sheet3").Range("SortAsc") = True Then url = url & "&order=a"
  If Sheets("Sheet3").Range("SortDesc") = True Then url = url & "&order=d"
  url = url & "&page=" & page
  xmlhttp.Open "GET", url, False 'GETメソッド、非同期通信で接続
  xmlhttp.send 'HTTPリクエストを実送信
  (略)
  resText = xmlhttp.responseText 'レスポンスを格納
  (略)
  Sheets("Sheet3").Range("requestPage") = page
  (略)

  xmldata.LoadXML resText 'レスポンスをXML文書として格納

  '(4)XML文書のResultSet要素にアクセスし、件数データを取得
  Set ResultSet = xmldata.DocumentElement
  Range("totalAvailable") =
  ResultSet.getAttribute("totalResultsAvailable")
  Range("totalReturned") = ResultSet.getAttribute("totalResultsReturned")
  Range("firstPosition") = ResultSet.getAttribute("firstResultPosition")

 cbPrev.Enabled = (Range("firstPosition") > 1)
 cbNext.Enabled = Range("firstPosition") +
 Range("totalReturned") <= Range("totalAvailable")

  (略)

  '(6)Item要素にアクセスし、商品リストを一旦配列変数に格納
  Set ItemList = ResultSet.getElementsByTagName("Item")
  ReDim goodsList(ItemList.Length - 1)
  Dim value As String, value2 As String
  For i = 0 To ItemList.Length - 1
      Set Item = ItemList(i)
      For j = 0 To Item.ChildNodes.Length - 1
          value = Item.ChildNodes(j).Text
          Select Case Item.ChildNodes(j).nodeName
          Case "Title"
              goodsList(i).title = value
          Case "AuctionItemUrl"
              goodsList(i).itemUrl = value
          Case "Seller"
              Set seller = Item.ChildNodes(j)
              For k = 0 To seller.ChildNodes.Length - 1
                  value2 = seller.ChildNodes(k).Text
                  Select Case seller.ChildNodes(k).nodeName
                  Case "Id"
                      goodsList(i).seller = value2
                  End Select
              Next k
          Case "CurrentPrice"
              goodsList(i).curPrice = value
          Case "EndTime"
              If value <> "" Then
                  goodsList(i).endTime = timeConv(value)
              End If
          End Select
      Next j
  Next i
  Set xmldata = Nothing 'XMLオブジェクトを解放

  '(7)商品リストから、ワークシートに転記
  clearData '前回の商品データをクリア
  For i = 0 To UBound(goodsList)
      ActiveSheet.Hyperlinks.Add _
          anchor:=Range("title_header").Offset(i + 1), _
          Address:=goodsList(i).itemUrl, _
          TextToDisplay:=goodsList(i).title
      Range("seller_header").Offset(i + 1) = goodsList(i).seller
      Range("price_header").Offset(i + 1) = goodsList(i).curPrice
      Range("time_header").Offset(i + 1) = goodsList(i).endTime
  Next

End Sub

(2)では、商品リストのリクエストURLに、パラメータ(先述の表4参照)を追加して送信しています。
また、リクエスト成功後は、ページを該当セルに格納しておきます。
(4)では、当該カテゴリの全商品数、取得された商品数、何番目から取得されたか、を該当セルに転記します。その条件に応じて、[次頁][前頁]ボタンの有効/無効を設定します。 (7)では、残存する商品データをクリアした上で、配列に格納された商品データをワークシートに転記します。その際、商品タイトルには詳細ページのURLをハイパーリンクとして設定します。

その他、商品リスト情報関連のプロシージャは以下の通りです(コードは省略)。

表12.カテゴリ情報関連のプロシージャ

名前 処理内容
cbList_Click 商品リスト(ページ1)を取得
cbNext_Click 次頁の商品リストを取得
cbPrev_Click 前頁の商品リストを取得
obPrice_Click ソート方法が変更されたので、[次頁へ][前頁へ]ボタンを無効に
obTime_Click (同上)
obAsc_Click (同上)
obDesc_Click (同上)

その他必要なVBAを記述する

Excelファイルを開いた際に、最上位のカテゴリを取得する必要があるため、VBエディタの左ペインで[ThisWorkBook]を選択し、コードウィンドウの上部で[Workbook]、[Open]を選択し、以下のリストを記述します。

[リスト4]プロシージャgetPage

  Private Sub Workbook_Open()

      Sheet1.getCate ("0")

  End Sub

最上位のカテゴリ情報を読み込むため、上記のコードウィンドウをクリックして、[F5]キーを一度、押下しておいてください。

その他、共通のプロシージャ・関数は以下の通りです(コードは省略)。VBエディタの左ペインで[Sheet1]を選択して、記述します。

表13.共通のプロシージャ・関数

名前 処理内容
clearCount 商品リスト取得関連の数値をクリア
clearData 商品リストのデータをクリア
timeConv RFC3339形式の日時形式を変換

以上で完成です。カテゴリ選択を繰り返し、末端のカテゴリに達したら、[取得]ボタンをクリックして、商品データが表示されれば成功です(完全なコードは、ここからダウンロードしてください)。

まとめ

ヤフオクの商品情報検索はいかがでしたか。取得したアプリケーションIDは、オークション以外の開発にも利用できます。以下のURLを参照してチャレンジしてみるのもいいでしょう。

http://developer.yahoo.co.jp/sitemap/
WINGSプロジェクト 遠藤 存著/山田祥寛監修
WINGS プロジェクトについて
テクニカル執筆プロジェクト(代表山田祥寛)。海外記事の翻訳から、主にWeb開発分野の書籍・雑誌/Web記事の執筆、講演等を幅広く手がける。2011年5月時点での登録メンバは35名で、現在も一緒に執筆をできる有志を募集中。