【Excel VBA】ウェブスクレイピングの紹介(2/2)

Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub get_list()

  'ポイント(1) InternetExplorerオブジェクトの生成
  Dim objIE As InternetExplorer
  Set objIE = New InternetExplorer
     
  'ポイント(2) 京のまち企業訪問ホームページを開く
  objIE.Visible = True
  objIE.Navigate "https://www5.city.kyoto.jp/kigyo/kg_102.cgi?CT=20&PN=1"

  'ポイント(3) ページが進む前に次の動作が始まるのを防ぐ
  Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
    DoEvents
  Loop
  
  'HTMLDocumentオブジェクトの生成
  Dim htmlDoc As HTMLDocument
  Set htmlDoc = objIE.document
  
  'ポイント(4) Excelシートの行数を格納する変数
  Dim counter_Excelrow As Integer
  'ポイント(5) ホームページのページ番号を格納する変数
  Dim counter_IEpage As Integer
  
  '1行目はリストのため、2行目からスタート
  counter_Excelrow = 2
  '1ページ目は既に開いているため、2ページ目からスタート
  counter_IEpage = 2
  
  'ポイント(6) データを抜き出すページ数に合わせて繰り返し回数を設定する (本プログラムでは10ページ分)
  '2022年4月時点の掲載企業3956件を全て網羅したい場合は400回試行が必要だが、注意が必要
  For counter_IEpage = 2 To 10
  
    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
      DoEvents
    Loop

    Dim i As Integer
    
    'ポイント(7) 1ページの企業数(10件)の数だけ試行を繰り返す
    For i = 0 To 9

      'Withステートメントを用いてオブジェクトの複数記載を省略
      'Class名を利用して企業情報にアクセス
      With ThisWorkbook.Worksheets(1)
        .Cells(counter_Excelrow, 1).Value = htmlDoc.getElementsByClassName("colset_article_ttl")(i).innerText
        .Cells(counter_Excelrow, 2).Value = htmlDoc.getElementsByClassName("colset_article_txt")(i).innerText
        'ポイント(8) Replace関数 & Mid関数を用いて不要な部分を削除
        .Cells(counter_Excelrow, 3).Value = Replace(Mid(htmlDoc.getElementsByClassName("colset_article_access")(i).innerText, 7), vbLf, "")
      End With
      
      '次の読み込みのため、企業情報を記録するExcelシートの行を1行下げる
      counter_Excelrow = counter_Excelrow + 1

        'ポイント(9) エラーが発生しても、無視して次のステップに進む
        On Error Resume Next

     Next

      Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
        DoEvents
      Loop
      
      'ポイント(10) アクセス間隔を1秒開ける
      Call Sleep(1000)

      'ポイント(11) 次のページに進む
      objIE.Navigate "https://www5.city.kyoto.jp/kigyo/kg_102.cgi?CT=20&PN=" & counter_IEpage & "&RDNG=&RDNG2="
    
  Next
  
End Sub