OKエクセル、アマゾンでマスクの在庫を確認してくれ！

全国的に品薄のマスク。
街の薬局を次から次へとマスクパトロールするひとも現れるてるほどマスクがない！

マスクがなくても朝イチから薬局を巡る訳にいかないサラリーマンはアマゾンでマスクの在庫をパトロール。ところが商品の数がありすぎて巡回パトロールも大変、、、そんなあなたに

私にいい考えがある。

ポチポチとクリックしていく単調な作業はパソコンに自動で任せよう。
私たちビジネスマンには万能アプリエクセルがある！！
エクセルを使ってマスクの在庫確認の作業を代行させてみるぞ。

エクセルでアマゾンの在庫状況を取得するには？

エクセルVBAを使ったIE制御でアマゾンの在庫状況を取得できるマクロを公開してくれたサイトがこちら。

【Webスクレイピング】VBAでAmazonの在庫ステータスを取得しよう

ExcelVBAを用いて、Amazonの在庫ステータスを取得する方法を解説します。サンプルコードあり。

とても詳しくコードの説明をしてくれてるのでマジ参考になった。参考どころか丸ごとコピペ。
シンプルに在庫を取得したいひと、コードの処理を詳しく知りたい人はリンク先のサイトに行ってみて。

OKエクセル、アマゾンにマスクの在庫があるかい？

先のコードをアレンジしてアマゾンから商品名、在庫状況、価格を調査するマクロVBAにしてみた。

フォーマットは Sheet1 にこんな感じで作っておく。

A列　ASIN
B列　商品名
C列　在庫状況
D列　価格

在庫状況を確認するのに必要なのは ASIN 番号だけ。
Amazonは扱っている商品を識別するためにASINという10桁の番号を商品ページの登録情報に記載している。アマゾンの商品ページで在庫状況を知りたい商品のASINをメモっておこいう。

このASIN番号をＡ列に入力してする。
マスクに限らずどんな商品でもだいじょぶだ。

入力が終わったらマクロを実行すれば順々に商品名、在庫状況、価格を取得していく。

エネループのASINを登録したデモ。
Amazon在庫タブの「在庫状況と価格」リボンを追加。押下でアマゾンの在庫パトロール！
回線やパソコンが速い人は TimeSerial 値を小さくするとウエイト時間が短くなる。

マクロVBAのコード

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#End If

'ShowWindowを使用

#If VBA7 Then
    Private Declare PtrSafe Function ShowWindow Lib "USER32" _
        (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Boolean
#Else
    Private Declare Function ShowWindow Lib "USER32" _
        (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean
#End If

Sub アマゾン在庫()
    Dim objIE As InternetExplorer
    Dim url As String
    Dim htmlDoc As HTMLDocument
    url = "https://www.amazon.co.jp/" '対象となるURL
    Dim ws As Worksheet
    Set ws = Worksheets(1)
    
    'IEを起動し表示させる
    Set objIE = CreateObject("Internetexplorer.Application")
    objIE.Visible = True
     
     Dim ret As Long
      ret = ShowWindow(objIE.hwnd, 2)

    Dim i As Long, lastRow As Long, ClearRow As Long
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    If ws.Cells(Rows.Count, 2).End(xlUp).Row = 1 Then
    ClearRow = 2
    Else
    ClearRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
    End If
    
    ws.Range("B2:D" &amp; ClearRow).ClearContents
    ws.Hyperlinks.Delete

Application.StatusBar = "Amazonへ在庫を問い合わせ中..."

    'ISBNの数だけループさせる
    For i = 2 To lastRow
        'Amazonのページを表示
        objIE.navigate (url)
        Call IEの読み込み待ち(objIE)

ws.Cells(i, 2).Value = "Amazonへ在庫を問い合わせ中..."
  
        Set htmlDoc = objIE.document
        
        'Amazonの検索窓を取得→ISBN(cells(i,2))を入力→検索ボタンをクリック
        Dim serchForm As HTMLInputTextElement
        Set serchForm = htmlDoc.getElementById("twotabsearchtextbox")
        serchForm.Value = ws.Cells(i, 1)
        Dim btnSerch As HTMLFormElement
        Set btnSerch = htmlDoc.getElementsByClassName("nav-input")(0)
        btnSerch.Click
        
        '検索結果の画面を取得し、最初のAnchor(リンク)を取得し、そのリンクに飛ぶ
        Call IEの読み込み待ち(objIE)
        Set htmlDoc = objIE.document
        Dim a As HTMLAnchorElement
        Set a = htmlDoc.getElementsByClassName("a-link-normal a-text-normal")(0)
        objIE.navigate (a.href)

 On Error Resume Next
        '在庫状況のテキストを書き込む
        Call IEの読み込み待ち(objIE)
        Set htmlDoc = objIE.document
        ws.Cells(i, 2).Value = htmlDoc.getElementById("productTitle").innerText 'outerText
        ws.Cells(i, 3).Value = htmlDoc.getElementById("availability").innerText 'outerText
        ws.Cells(i, 4).Value = htmlDoc.getElementById("priceblock_ourprice").innerText
        
        Dim hyplink  As Hyperlink
 
        'セルへのハイパーリンク設定
        Set hyplink = ActiveSheet.Hyperlinks.Add(Anchor:=ws.Cells(i, 2), _
                   Address:="http://amazon.co.jp/o/ASIN/" &amp; ws.Cells(i, 1), _
                   TextToDisplay:=ws.Cells(i, 2).Value)
    Next
    
    Application.StatusBar = ""
    objIE.Quit
   
    MsgBox "在庫状況を確認しました。" &amp; Chr(13) &amp; Chr(13) &amp; _
    "商品名をクリックするとAmazonへリンクします。" &amp; Chr(13) &amp; "" _
    , vbInformation + vbOKOnly, "【Amazon在庫】"

End Sub

Sub IEの読み込み待ち(objIE)
  Dim timeOut As Date

  '完全にページが表示されるまで待機する
  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.Busy = True Or objIE.readyState &lt;&gt; 4
    DoEvents
    Sleep 1
    If Now &gt; timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
  Loop

  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.document.readyState &lt;&gt; "complete"
    DoEvents
    Sleep 1
    If Now &gt; timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
   Loop
End Sub