スクレイピングで、ASINから、情報を取得
以下のシートを例にマクロを紹介します。
![](https://blogvba.com/wp-content/uploads/2023/10/スクリーンショット-2023-10-15-153937-1024x190.png)
A列のASINから情報(タイトル・発行年・出版社・著者・ページ数・ランキング)を取得するマクロです。Webブラウザ(Edge/Chrome)の自動操作のために、Seleniumを使用しています。ブラウザはEdgeを使用しています。以下がマクロの全体です。
Option Explicit
' 列挙型で列番号を指定
Enum clm
ASIN = 1
タイトル列
発行年列
出版社列
著者列
ページ数列
ランキング列
End Enum
Dim driver As Selenium.WebDriver
Dim htmlDoc As HTMLDocument
Dim ランキング As Long
Dim タイトル As String
Dim 出版社 As String
Dim 発行年 As String
Dim ページ数 As String
Dim 著者 As String
Sub main()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("01")
Dim LastRw As Long
LastRw = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim rw As Long
For rw = 2 To 2 'LastRw
' 変数の初期値設定
ランキング = 0
タイトル = ""
出版社 = ""
発行年 = ""
ページ数 = ""
著者 = ""
Call ASINから情報を取得(ws.Cells(rw, clm.ASIN))
ws.Cells(rw, clm.ランキング列) = ランキング
ws.Cells(rw, clm.タイトル列) = タイトル
ws.Cells(rw, clm.出版社列) = 出版社
ws.Cells(rw, clm.発行年列) = 発行年
ws.Cells(rw, clm.ページ数列) = ページ数
ws.Cells(rw, clm.著者列) = 著者
Next rw
End Sub
' ASINから
Sub ASINから情報を取得(ByVal ASIN As String)
Set driver = New Selenium.WebDriver
' Edgeを開く
driver.Start "edge"
'ASINから作成したURL
Dim URL As String
URL = "https://www.amazon.co.jp/o/asin/"
URL = URL & ASIN & "/"
' URLを開く
driver.Get URL
'■ブラウザ読み込み待ち(ページロード待ち)する
driver.Wait 500 '0.5秒待つ。
'「HTMLDocument」のオブジェクトで「htmlDoc」を宣言し(この時点ではhtmlDocはただの箱)、Newする』ことで、「HTMLDocument」の構造を「htmlDoc」にセットしインスタント化する。
' 「htmlDoc」にある「body」内の「innerHTML」に「driver.PageSource」を貼り付ける。
Set htmlDoc = New HTMLDocument
htmlDoc.body.innerHTML = driver.PageSource
' ランキングを、正規表現を使用して、取得
ランキング = ランキング_from_HTML(driver.PageSource)
' 指定のCSSセレクタのデータをすべて取得
Dim els
Dim m As Long
' タイトルを取得。
Set els = htmlDoc.querySelectorAll("#productTitle")
If els Is Nothing Then
MsgBox "「タイトル」の要素が見つかりません"
Else
' 前後の空白行を削除
タイトル = Trim(els(0).innerText)
End If
'出版社、発行年、ページ数を取得するため、「登録情報」を取得
Dim 登録情報arr(0 To 10) As Variant
Set els = htmlDoc.querySelectorAll("#detailBullets_feature_div > ul > li > span > span")
If els Is Nothing Then
MsgBox "「登録情報」の 要素が見つかりません"
Else
For m = 0 To 10
If els(m) Is Nothing Then Exit For
登録情報arr(m) = els(m).innerText
Next m
End If
' 登録情報から出版社・発行年・ページ数を取得。
For m = 0 To UBound(登録情報arr)
' 出版社があれば、次の項目を取得
If InStr(登録情報arr(m), "出版社") > 0 Then
'二見書房 (1978/1/1) を分割
Dim var As Variant
var = Split(登録情報arr(m + 1), " (")
出版社 = var(0)
'1978/1/1) を分割
var = Split(var(1), "/")
If IsNumeric(var(0)) = True Then
発行年 = var(0)
End If
End If
If InStr(登録情報arr(m), "ページ") > 0 Then
Dim PageTxt As String
PageTxt = Replace(登録情報arr(m), "ページ", "")
If IsNumeric(PageTxt) = True Then
ページ数 = PageTxt
End If
End If
Next m
If ページ数 = "" Then ページ数 = "なし"
' 著者を取得
Dim 著者arr(0 To 10) As Variant
Set els = htmlDoc.querySelectorAll("#bylineInfo")
If els Is Nothing Then
MsgBox "要素が見つかりません"
Else
For m = 0 To 10
If els(m) Is Nothing Then Exit For
著者arr(m) = els(m).innerText
Next m
End If
著者 = Trim(著者arr(0))
' ブラウザを閉じる
driver.Close
End Sub
Function ランキング_from_HTML(ByVal URL As String) As Long
Dim re As Object
Dim mc As Object
Dim msg As String
Dim i As Long
'RegExpオブジェクトを作成する
Set re = CreateObject("VBScript.RegExp")
With re
'正規表現パターンを設定する
' https://www.megasoft.co.jp/mifes/seiki/s012.html
' - 164,994位本
.Pattern = "[-]\s\b\d{1,3}(,\d{3})*\b[位]"
'複数マッチを有効にする
.Global = True
'文字列「ExcelVBA PoerPoint AccessVBA」に対して実行する
Set mc = .Execute(URL)
End With
'結果に対して処理を行う
With mc
'対象文字列が見つかったかどうか判定する
If .Count > 0 Then
'見つかった場合、文字列を取得する
msg = .Item(i).Value
Else
'見つからなかった場合の文字列
msg = ""
End If
End With
'MsgBox msg
msg = Replace(Replace(Replace(msg, "-", ""), "位", ""), ",", "")
ランキング_from_HTML = CLng(Val(msg))
End Function
以下が実行した結果です。
![](https://blogvba.com/wp-content/uploads/2023/10/スクリーンショット-2023-10-15-155316-1024x269.png)
サンプルのマクロブックは、以下から、ダウンロードしてください。
Seleniumを使用するための、事前準備は、以下を参照してください。