解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

インターネットから自動で情報を取ってくる[VBA]準備〜 HTML ソースコードを取得する〜



こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。


この記事の目次



背景・目的


VBA は最近の Python や Ruby などと比べると長いソースコードを書く必要があります。

また、 VBA はスクレイピングに向いていません。

なので、スクレイピングしたい Web サイトがあっても HTML に合わせて長いプログラムを書く必要があるので、簡単ではありません。

そこで、気になった Web サイトがあったら、 HTML の分析を手助けしてくれる VBA マクロを作りました。

ある程度型にはまったプログラミングも重要です。



動作環境


・Windows 7
・Excel 2007
・Internet Explorer



環境と素材の準備

リンクの記事で VBScript と VBA でアイコン設定などをしたアプリケーションを作成しました。
Excel VBA と VBScript で 自作アイコンとドラッグ&ドロップが出来るアプリケーションを作る - 解析エンジニアの自動化 blog

今回もアプリケーションとして作成します。
詳細な設定、作成方法はリンクの記事を参照ください。

アプリフォルダの作成

デスクトップに『 ScraparseVBA_v0.0 』というフォルダを作成し、図1 の様にサブフォルダを作成します。


図1 アプリフォルダの作成


アイコンの作成

シンプルに抽出の『 抽 』という文字でアイコンを作りました。


図2 作成したアイコン



プログラム

Excel に Web サイト URL など、色々入力する必要があるため、 VBScript からマクロ有効ブックを起動するだけのアプリケーションにしました。

VBScript ファイル


図3 VBScript ファイル


VBScript ソースコード


'---------------------------------------------------------------------
' 自分自身(この.vbs)のファイルがあるフォルダの親フォルダ取得
'---------------------------------------------------------------------
path = CreateObject("Scripting.FileSystemObject").getParentFolderName(WScript.ScriptFullName)
pos = instrrev(path, "\")
path = mid(path, 1, pos-1)
'msgbox path
 
'-----------------------------
' Excel オブジェクトの作成
'-----------------------------
Set obj = WScript.CreateObject("Excel.Application")
obj.Visible = True
 
'---------------
' Excel を開く
'---------------
obj.Workbooks.Open path & "\SubProgram\ScraparseVBA_v0.0.xlsm"
 
'--------------
' メモリ解放
'--------------
Set objShell = Nothing

VBA ファイル


図4 マクロ有効ブック


図5 マクロ有効ブックの中身


シート上のボタン用 VBA ソースコード


Private Sub CommandButton1_Click()
   
    Call 解析HTML取得
   
End Sub

標準モジュール用 VBA ソースコード


Public targetURL
 
 
 
Sub 解析HTML取得()
   
    targetURL = ThisWorkbook.Worksheets("操作画面").Cells(10, 3).Value
   
    '///// ターゲット URL の IE ブラウザを探して捕まえる /////
    Set objIE = getObjectIE(targetURL)
   
    '///// ターゲット URL の IE ブラウザが無いなら新しく開く /////
    If objIE Is Nothing Then
        Set objIE = IEブラウザ起動(targetURL)
    End If
   
    '--------------------------------------------------------
    ' ページが読み込まれるまで待つ
    '--------------------------------------------------------
    Do While objIE.Busy = True Or objIE.readyState <> 4
       
        '-----------------------------------------------------
        ' 100 ミリ秒～ 120 ミリ秒処理を止める
        '-----------------------------------------------------
        Call Waiting(100, 120)
   
    Loop
   
    '---------------------------------------------------------------
    ' 1000 ミリ秒～ 2500 ミリ秒処理を止める
    '---------------------------------------------------------------
    Call Waiting(1000, 2500)
   
    ' タグ毎に改行を入れる
    HTML = Replace(objIE.document.all(0).outerHTML, ">", ">" & vbNewLine)
   
    ' デスクトップに "WebScraparse" というフォルダを作成する
    Set WSH = CreateObject("WScript.Shell")
    myPath = WSH.SpecialFolders("Desktop") & "\" & "WebScraparse" & "\"
    If Dir(myPath) = "" Then
        MkDir myPath
    End If
   
    ' 作成したフォルダに HTML 出力
    txtFile = myPath & ファイル名作成(targetURL) & "_HTML" & ".txt"
   
    Open txtFile For Output As #1
        Print #1, HTML
    Close #1
   
    Call AutoMsg(" HTML 出力完了")
   
End Sub
 
 
 
Function getObjectIE(ByVal targetURL)
  
   '-----------------------------------------------------------
   ' シェルオブジェクトの生成
   '-----------------------------------------------------------
   Set objShell = CreateObject("Shell.Application")
  
   '-----------------------------------------------------------
   ' ウインドウコレクションのスキャン
   '-----------------------------------------------------------
   Set objIE = Nothing
  
   For Each objWindow In objShell.Windows
     
      '--------------------------------------------------------
      ' IWebBrowser2 だったら
      '--------------------------------------------------------
      If TypeName(objWindow) = "IWebBrowser2" Then
        
         '-----------------------------------------------------
         ' Internet Explorer だったら
         '-----------------------------------------------------
         Debug.Print objWindow.Name
        
         If objWindow.Name = "Internet Explorer" Then
           
            '--------------------------------------------------------
            ' ページが読み込まれるまで待つ
            '--------------------------------------------------------
            Do While objWindow.Busy = True Or objWindow.readyState <> 4
               
                '-----------------------------------------------------
                ' 100 ミリ秒～ 120 ミリ秒処理を止める
                '-----------------------------------------------------
                Call Waiting(100, 120)
               
            Loop
           
            ' ループで今、見つかった IE の URL を記憶する
            LookAtURL = objWindow.locationURL
           
            '--------------------------------------------------
            ' targetURL が見つかったら
            '--------------------------------------------------
            If LookAtURL = targetURL Then
               Set objIE = objWindow ' IE オブジェクトを取得して
               Exit For              ' ループを抜け出す
            End If
           
         End If
        
      End If
     
   Next
  
   Set objShell = Nothing ' シェルオブジェクト破棄
  
   '-----------------------------------------------------------
   ' 対象IEオブジェクトがあった場合
   '-----------------------------------------------------------
   If objIE Is Nothing Then
     
      Call AutoMsg("対象となる Web は IE で開かれていませんでした。")
     
   End If
  
   Set getObjectIE = objIE
  
End Function
 
 
 
Function IEブラウザ起動(ByVal targetURL)
  
   '--------------------------------------------------------
   ' IE オブジェクトの生成
   '--------------------------------------------------------
   Set objIE = CreateObject("InternetExplorer.Application")
  
   '--------------------------------------------------------
   ' IE オブジェクトの可視化
   '--------------------------------------------------------
   objIE.Visible = True
  
   '--------------------------------------------------------
   ' 1000 ミリ秒～ 3000 ミリ秒処理を止める
   '--------------------------------------------------------
   Call Waiting(1000, 3000)
  
   '--------------------------------------------------------
   ' IEを開く
   '--------------------------------------------------------
   objIE.Navigate targetURL
  
   '--------------------------------------------------------
   ' ページが読み込まれるまで待つ
   '--------------------------------------------------------
   Do While objIE.Busy = True Or objIE.readyState <> 4
     
      '-----------------------------------------------------
      ' 100 ミリ秒～ 120 ミリ秒処理を止める
      '-----------------------------------------------------
      Call Waiting(100, 120)
     
   Loop
  
   Set IEブラウザ起動 = objIE
  
   Set objIE = Nothing
  
End Function
 
 
 
Sub Waiting(ByVal a, ByVal b)
  
   ' a 以上 b 以下の乱数を作成
   Lambda = Int(Rnd() * (b - a + 1) + a)
  
   ' Lambda ミリ秒処理を止める
   Application.Wait [Now()] + Lambda / 86400000
  
End Sub
 
 
 
Sub AutoMsg(ByVal msg)
   
    '------------------------------
    ' シェルオブジェクトの生成
    '------------------------------
    Set objShell = CreateObject("WScript.Shell")
   
    '------------------
    ' メッセージ表示
    '------------------
    objShell.PopUp msg, 1
   
    '--------------
    ' メモリ解放
    '--------------
    Set objShell = Nothing
   
End Sub
 
 
 
Function ファイル名作成(ByVal ファイル名)
   
    'ファイル名 = "https://www.yahoo.co.jp/"
   
    置換前 = ファイル名
   
    ' ファイル名に使用できない もしくは 使用しない方がいい文字列の設定
    禁止文字 = Array("\", "/", ":", ";", "*", "?", """", "<", ">", "|", ".", ",", " ", "+", "(", ")", "[", "]", "{", "}", "$", "%", "&", "#", "^", "@")
   
    ' 引数「ファイル名」の「禁止文字」配列に該当する文字を "-" に置換する
    For i = LBound(禁止文字) To UBound(禁止文字)
       
        ファイル名 = Replace(ファイル名, 禁止文字(i), "-")
       
    Next i
   
    ' イミディエイトに置換前後のファイル名出力
    Debug.Print "置換前：" & 置換前
    Debug.Print "置換後：" & ファイル名
   
    ' 戻り値
    ファイル名作成 = ファイル名
   
End Function



結果



図6 作成したアプリケーション



図7 『HTML取得』ボタンを押して出来る出力フォルダ



図8 出力されたテキストファイル



図9 出力されたテキストファイルの中身



コメント

アイコンの作り方、VBScript ファイルの作り方などなど、アプリケーション化の詳しいやり方は下のリンクの記事でまとめています。
Excel VBA と VBScript で 自作アイコンとドラッグ&ドロップが出来るアプリケーションを作る - 解析エンジニアの自動化 blog

このままではそこまでスクレイピングに役立つことはないかもしれません。

どんどん改造していきたいです。



以上