スクレイピングで、ASINから、情報を取得

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