前提・実現したいこと
はじめまして、スクレイピング初心者です。
現在、VBAでスクレイピングの勉強をしたいと思い、ネットで検索しながら日々奮闘しています。
やりたいことは、自分がよく使用するAmazonや楽天で、商品の価格を収集して比較し、一番安いサイトで購入することです。
しかし、htmlも勉強しながら構築していますが、VBAによるスクレイピングがうまくいきません。
なにとぞ、皆さんの英知をお貸しいただけるととてもありがたいです。
よろしくお願いいたします。
発生している問題・エラーメッセージ
商品名・ショップ名の取得が正しくない(どのタグを拾うべきかわからない) 「オブジェクトが必要です」
該当のソースコード
前提:スクレイピングしたい商品情報を検索し、ページを展開してからマクロを起動する
Option Explicit
'【要確認】
'webスクレイピングをするために環境設定を行う
'参考:https://rabbitfoot.xyz/vba-automation-ws1/
'楽天のお気に入りページを開いた上で実行してください。
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
'-----------------------------------------------------------------
'現在IEで開いている楽天の商品ページの情報を、シート状に取得する
'-----------------------------------------------------------------
Sub main()
Dim objIE As InternetExplorer '楽天の商品ページを格納
Dim sProductName As String '商品名
Dim sProductURL As String '商品URL
Dim ShopName As String 'ショップ名称
'IE取得関連 Dim objShell As Object 'shellオブジェクト格納 Dim objWindow As Object 'ウィンドウを格納 Dim vTmp As Variant Dim iIdx As Integer '画像取得関連 Dim objdivTags As Object '全divタグを格納 Dim objdiv As Object Dim sClassName As String 'タグのクラス名を格納 Dim iRow As Integer '---------楽天のページを取得する処理--------- Set objShell = CreateObject("Shell.Application") For Each objWindow In objShell.Windows 'IEウィンドウの判定 If InStr(LCase(objWindow.FullName), "iexplore.exe") > 0 Then 'タイトルに楽天.co.jpが含まれていれば商品ページと判定 If InStr(objWindow.document.Title, "楽天") > 0 Then Set objIE = objWindow Exit For End If End If Next '楽天のページが見つからなかった場合の処理 If objIE Is Nothing Then MsgBox "商品ページの取得ができませんでした。" End End If '---------------------------------------------- sProductName = objIE.document.getElementsByClassName("styles__title___B_fG6") sProductURL = objIE.document.getElementsByClassName("styles__blackLink___1Y806") ShopName = objIE.document.getElementsByClassName("ricon-shop-simple") '改行ごとに分割し、頭に「●」印を付けて再度結合させる vTmp = Split(objIE.document.getElementById("feature-bullets").innerText, vbCrLf) **__←エラー箇所__** For iIdx = 0 To UBound(vTmp) If Trim(vTmp(iIdx)) <> "" Then ShopName = ShopName & "●" & Trim(vTmp(iIdx)) & vbCrLf End If Next '最終行+1を書き込み対象行に設定する iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 Cells(iRow, 1).Value = sProductName Cells(iRow, 2).Value = sProductURL Cells(iRow, 3).Value = ShopName
End Sub
VBA