0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

初心者がVBAでスクレイピングしてみた

Posted at

はじめに

初めてVBAを触り、Webサイトのスクレイピングをするまでにやったことの記録。

やりたいこと

Webサイトに掲載されている各商品ページについて、特定のclassの3つ目に記載されている文言を抜き出し、Excelのシート上に書き出す。

※Excelのイメージ

商品名 URL 3つ目に記載されている文言
商品A http:\\xxx.com/xxx ・・・
商品B http:\\xxx.com/yyy ・・・

事前準備

スクレイピングするための準備

「ツール」>「参照設定」から以下にチェックを入れる。
・Microsoft HTML Object Library
・Microsoft Internet Controls
image.png

ソースコード

class名は固定なので、ソースコードに埋め込み。
ExcelのA列のURLを読み取り、B列に要素を書き込む。

ChatGPT先生に色々お願いして書いてもらいました。

Sub ScrapeAndWriteToExcel()
    Dim ie As Object
    Dim html As Object
    Dim elements As Object
    Dim element As Object
    Dim targetURL As String
    Dim className As String
    Dim tagText As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long


    ' クラス名を設定
    className = "example-class"
    
    ' 対象のシートを設定
    Set ws = ThisWorkbook.Sheets(1)
    
    ' URLが書かれているA列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    
    ' IEオブジェクトを作成
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False ' IEウィンドウを表示しない


    ' URLの数だけループ
    For i = 1 To lastRow
        ' A列のURLを取得
        targetURL = ws.Cells(i, 1).Value
        
        ' URLが空でない場合のみ処理を行う
        If targetURL <> "" Then
            ' 指定したURLにナビゲート
            ie.navigate targetURL

            ' ページの読み込み完了を待つ
            Do While ie.Busy Or ie.readyState <> 4
                DoEvents
            Loop

            ' HTMLドキュメントを取得
            Set html = ie.document

            ' 指定されたクラス名の要素を取得
            On Error Resume Next
            Set elements = html.getElementsByClassName(className)
            On Error GoTo 0

            ' 要素が見つかった場合、3つ目の要素のテキストを取得
            If Not elements Is Nothing And elements.Length >= 3 Then
                Set element = elements(2) ' インデックスは0から始まるため3つ目は2
                tagText = element.innerText
                
            Else
                tagText = "クラスが見つかりません"
            End If

            ' 結果をB列に書き込む
            ws.Cells(i, 2).Value = tagText
            
        End If
    Next i

    ' IEオブジェクトを終了
    ie.Quit
    Set ie = Nothing
    Set html = Nothing
    Set elements = Nothing
    Set element = Nothing
    
    ' 完了メッセージを表示
    MsgBox "完了しました", vbInformation, "完了"

End Sub

さいごに

結局、ChatGPT先生様様なのでありました・・・

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?