Amazonの価格を取得する with ExcelVBA

#【概要】
Excelからボタン１クリックで自分が知りたいAmazon商品の価格を取得できます。
（抽出の仕方に不足があるかもしれないので、すべての商品の価格が取得できるとは限りませんので、ご了承ください）

#【環境】
・windows8.1
・Excel 2013

#【機能】
・前回取得した価格の最安値と今回取得した最安値の比較ができる（画像では最安値列）。
・Kindle版が存在していた場合、Kindle版の価格を取得できる。
・中古や新品の商品の価格を取得できる。

#【取得結果】
こんな感じで価格を取得できます。
「価格教えて！」ボタンをクリックすると「価格検索」シートに商品名および価格が表示されます。

#【問題点】
　IEの画面表示を非表示にしているためか、大量のIEプロセスが作成されてしまいCPU使用率が
　大きくなってしまいます。

#【問題対応】
　[方法１]
　　VBAでQuitできなかった大量のIEプロセスを一気に閉じる
　　こちらのサイトの方法を使ってプロセスを閉じるかタスクマネージャで閉じる。
　[方法２]
　　Module1のCall viewIE(objIE, url)をCall viewIE(objIE, url, True)に変更する。
　　変更してプログラムを実行するとIEが立ち上がってとても邪魔になります。

#【価格取得方法】
（１）Excelを立ち上げA1のセルに「URL一覧」、シート名に「url」と記入する（記入する文字は適当でいいです）。
（２）A2セルから順に価格を知りたい商品のURLを記入する。
（３）シート名が「価格検索」という名前のシートを作成し、上記画像のようにヘッダー情報（商品名、最安値など）を記入する。
（３）Alt + F11 を押してVBAのIDEを立ち上げる。
（４）左上にあるプロジェクトエクスプローラーにあるプロジェクト名「VBAProject」を右クリックし、「挿入」→「標準モジュール」をクリックする。
（５）Sheet1(url), Module1にそれぞれ下記プログラムをコピペする。
（６）「url」シートにマクロボタンを作成し、クリックする。
（７）価格検索シートに結果が表示されます。

#【プログラム】

Sheet1(url)

Option Explicit

Sub findPrice()

    Dim i As Integer
    Dim findUrlRowNo As Integer
    
    If Range("A2").Value <> "" Then
     findUrlRowNo = Range("A1").End(xlDown).Row
    Else
     findUrlRowNo = Range("A1").End(xlUp).Row
    End If
    
    For i = 2 To findUrlRowNo
        viewAmazonPrice (Cells(i, 1))
    Next i
    
End Sub

Module1

Option Explicit

Sub viewAmazonPrice(ByVal url As String)
   Worksheets("価格検索").Activate

   ' IEのオブジェクト用
   Dim objIE As Object

   Call viewIE(objIE, url)

   If 0 < InStr(objIE.document.all(0).outerHTML, "tmmSwatches") Then
     Call writeBookPrice(objIE)
   Else
     Call writeOtherPrice(objIE)
   End If
   'IEを閉じてオブジェクトを空にする
   objIE.Quit
   Set objIE = Nothing

End Sub

' IEの起動関数
' @param objIE IE用のオブジェクト
' @param urlName 接続先URL
' @param viewFlg IEの表示、非表示　デフォルトでは非表示
Sub viewIE(ByRef objIE As Object, ByVal urlName As String, Optional ByVal viewFlg As Boolean = False)
  ' IEのオブジェクト作成
  Set objIE = CreateObject("InternetExplorer.Application")
  ' 画面の表示
  objIE.Visible = viewFlg
  ' URLの設定
  objIE.navigate urlName
  Call checkIE(objIE)
End Sub

' IEの読み込み完了確認関数
Sub checkIE(ByRef objIE As Object)
  Dim timeOut As Date
  ' 現在から２０秒後を設定
  timeOut = Now + TimeSerial(0, 0, 20)
  
  ' webページとドキュメントの読み込みが完了するまでループ処理
  Do While objIE.busy = True Or objIE.readystate <> 4
    DoEvents
    If timeOut < Now Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
  Loop
  
  timeOut = Now + TimeSerial(0, 0, 20)
  
  Do While objIE.document.readystate <> "complete"
    DoEvents
    If timeOut < Now Then
     objIE.Refresh
     timeOut = Now + TimeSerial(0, 0, 20)
    End If
  Loop
End Sub

' 商品が本の価格書き込み
Sub writeBookPrice(ByRef objIE As Object)
   ' 抽出したHTML
   Dim htmlText As String
   ' 抽出したHTMLを分割する
   Dim splitHtmlText As Variant
   ' for文用
   Dim i As Integer
   ' 現状または今までの最安値　デフォルトで５０万を設定
   Dim minPrice As Long: minPrice = 500000
   ' 書き込む行番号
   Dim writeRow As Integer
   ' 商品のタイトル
   Dim title As String
   Dim findTitle As Range

   ' タイトル取得
   title = objIE.document.getelementsbytagname("title")(0).innerText
   ' 必要な情報を抽出
   htmlText = objIE.document.getelementbyid("tmmSwatches").innerText
   htmlText = Replace(htmlText, " ", "")
   htmlText = Replace(htmlText, "今すぐお読みいただけます:無料アプリ", vbCrLf)
   htmlText = Replace(htmlText, "より", vbCrLf)
   splitHtmlText = Split(htmlText, vbCrLf)
   
   ' 書き込み行の取得
   Set findTitle = Range("A:A").Find(title)
   ' 既に価格取得を行っていた商品
   If Not findTitle Is Nothing Then
     writeRow = Range("A:A").Find(title).Row
   ' ヘッダー行のみだった場合の対策
   ElseIf Range("A2").Value <> "" Then
     writeRow = Range("A1").End(xlDown).Row + 1
   Else
     writeRow = Range("A1").End(xlUp).Row + 1
   End If

   ' タイトル書き込み
   Cells(writeRow, 1) = title
         
  ' 商品の売却種類（中古とか単行本とか）ごとに書き込み
   For i = 0 To UBound(splitHtmlText)
      If InStr(splitHtmlText(i), "Kindle") <> 0 Then
        Cells(writeRow, 3) = splitHtmlText(i + 1)
        If splitHtmlText(i + 1) < minPrice And splitHtmlText(i + 1) <> 0 Then
          minPrice = splitHtmlText(i + 1)
        End If
      ElseIf InStr(splitHtmlText(i), "単行本") <> 0 Then
        Cells(writeRow, 4) = splitHtmlText(i + 1)
        If splitHtmlText(i + 1) < minPrice And splitHtmlText(i + 1) <> 0 Then
          minPrice = splitHtmlText(i + 1)
        End If
      ElseIf InStr(splitHtmlText(i), "中古") <> 0 Then
        Cells(writeRow, 5) = splitHtmlText(i - 1)
        If splitHtmlText(i - 1) < minPrice And splitHtmlText(i - 1) <> 0 Then
          minPrice = splitHtmlText(i - 1)
        End If
      ElseIf InStr(splitHtmlText(i), "新品") <> 0 Then
        Cells(writeRow, 6) = splitHtmlText(i - 1)
        If splitHtmlText(i - 1) < minPrice And splitHtmlText(i - 1) <> 0 Then
          minPrice = splitHtmlText(i - 1)
        End If
      ElseIf InStr(splitHtmlText(i), "コレクター") <> 0 Then
        Cells(writeRow, 7) = splitHtmlText(i - 1)
        If splitHtmlText(i - 1) < minPrice And splitHtmlText(i - 1) <> 0 Then
          minPrice = splitHtmlText(i - 1)
        End If
      End If
   Next i
   
   ' 最安値の書き込み
   If Cells(writeRow, 2) < minPrice And Cells(writeRow, 2) <> 0 Then
     minPrice = Cells(writeRow, 2)
   End If
   Cells(writeRow, 2) = Format(minPrice, "\\ #,###")
End Sub

' 本以外の商品の価格書き込み
Sub writeOtherPrice(ByRef objIE As Object)
   ' for文用
   Dim i As Integer
   ' 現状または今までの最安値　デフォルトで５０万を設定
   Dim minPrice As Long: minPrice = 500000
   ' 書き込む行番号
   Dim writeRow As Integer
   ' 商品のタイトル
   Dim title As String
   Dim findTitle As Range
  ' 通常価格
  Dim ourPrice As Integer
  ' セール価格
  Dim salePrice As Integer
  ourPrice = objIE.document.getelementbyid("priceblock_ourprice").innerText
  ' セール価格が存在するか確認する
  If InStr(objIE.document.all(0).outerHTML, "priceblock_dealprice") <> 0 Then
    salePrice = objIE.document.getelementbyid("priceblock_dealprice").innerText
  Else
    salePrice = 0
  End If

   ' タイトル取得
   title = objIE.document.getelementsbytagname("title")(0).innerText
   
   ' 書き込み行の取得
   Set findTitle = Range("A:A").Find(title)
   ' 既に価格取得を行っていた商品
   If Not findTitle Is Nothing Then
     writeRow = Range("A:A").Find(title).Row
   ' ヘッダー行のみだった場合の対策
   ElseIf Range("A2").Value <> "" Then
     writeRow = Range("A1").End(xlDown).Row + 1
   Else
     writeRow = Range("A1").End(xlUp).Row + 1
   End If

   ' タイトル書き込み
   Cells(writeRow, 1) = title
   
   ' 最安値の設定
   If ourPrice <> 0 And ourPrice < minPrice Then
       minPrice = ourPrice
   End If
   If salePrice <> 0 And salePrice < minPrice Then
       minPrice = salePrice
   End If
   
   ' 通常価格とセール価格の書き込み
   Cells(writeRow, 8) = Format(ourPrice, "\\ #,###")
   If salePrice <> 0 Then
    Cells(writeRow, 9) = Format(salePrice, "\\ #,###")
   End If
  
   ' 最安値の書き込み
   Cells(writeRow, 2) = Format(minPrice, "\\ #,###")
End Sub

#【アドバイスなど】
何かアドバイス、コードミスなどありましたら教えていただきたいです。

#【参考URL】
　　VBAのIE制御入門