Gumma_de_Sharoushiのブログ

群馬で社労士として開業をめざします。→開業しました。

多くなりすぎたフォロワーを把握するには

別ブログで少し触れたVBAのコードです。 いろいろ差しさわりがあるので、こちらに掲載します。

コード

標準モジュール
Option Explicit

Const DoPage_CONSTTIMES As Long = 1 '5

'Const BROWSER_NAME   As String = "chrome"
'Const BROWSER_NAME   As String = "ie"
'Const BROWSER_NAME   As String = "opera"
Const BROWSER_NAME   As String = "MicrosoftEdge"


Public Sub ShowWebSite_DoTest()

    'Selenium.ChromeDriver | Selenium.EdgeDriver | Selenium.IEDriver | Selenium.OperaDriver
    'Selenium.FirefoxDriver | Selenium.PhantomJSDriver
    Dim driver As Object
    Set driver = CreateObject("Selenium.WebDriver")
    
    '「Selenium.WebDriver」で定義したのならばBROWSER_NAMEを指定。
    '「Selenium.WebDriver」以外ならばこの一行は不要
    driver.Start BROWSER_NAME
    driver.Get "https://mobile.twitter.com/mob_sharoushi/following"
    driver.Window.Maximize
    driver.Wait 1000
    
    Call DoPage(driver, DoPage_CONSTTIMES)
    
    MsgBox "End"
    driver.Close
    Set driver = Nothing
End Sub

Private Sub DoPage(ByVal driver As Object, ByVal Times As Long)
    Dim lSoeji As Long  '動的タグdiv[]の添え字
    Dim divTag As Object
    Dim objTag As Object
    Dim oTag As Object
    Dim jj As Long
    Dim lSpanCnt As Long    '名前に絵文字などの画像を使っている場合、spanがspan[]になるので、その添え字数
    Dim stNameBuf As String '取得した名前(例:野口香社会保険労務士事務所)
    Dim stScreenName As String  '取得したスクリーンネーム(例:mob_sharoushi)
    Dim Buf As Variant
    Dim Dic As Object
    Dim cls As Class1   '辞書に登録するItemをまとめたクラス
    Dim Keys As Variant
    Dim Var() As Variant
    Const cstStyle As String = "transform: translateY"  '添え字を持つdivを特定するためのstyle特性
    
    Set Dic = CreateObject("Scripting.Dictionary")
    
    driver.Wait 2000
    
    Dim LoopCount As Long
    LoopCount = 0
    
    Dim doHeight_Before As Long
    doHeight_Before = 0
    
    Dim doHeight_Now As Long
    doHeight_Now = driver.ExecuteScript("return document.documentElement.scrollHeight;")
    Do While (doHeight_Before <> doHeight_Now)
        '名前までのXPath(の一部)
        Set divTag = driver.FindElementByXpath("//*[@id=""react-root""]/div/div/div[2]/main/div/div/div/div/div/section/div/div")
        
        '現在表示されているフォローリストが何件分なのか、divタグのstyle特性をもとに把握
        lSoeji = 0
        For Each oTag In divTag.FindElementsByTag("div")
            If Left(oTag.Attribute("style"), Len(cstStyle)) = cstStyle Then
                lSoeji = lSoeji + 1
            End If
        Next oTag

        For jj = 1 To lSoeji - 1
            '名前までのXPath(の一部)
            Set objTag = driver.FindElementByXpath("//*[@id=""react-root""]/div/div/div[2]/main/div/div/div/div/div/section/div/div/div[" & jj & "]/div/div/div/div[2]/div[1]/div[1]/div/div[1]/a/div/div[1]/span")
            lSpanCnt = objTag.FindElementsByTag("span").Count
            stNameBuf = ""
            If lSpanCnt > 1 Then
    
                For Each oTag In objTag.FindElementsByTag("span")
                    stNameBuf = stNameBuf & oTag.Text
                Next oTag
            Else
                stNameBuf = objTag.FindElementByTag("span").Text
            End If
            'スクリーンネームを取得
            stScreenName = driver.FindElementByXpath("//*[@id=""react-root""]/div/div/div[2]/main/div/div/div/div/div/section/div/div/div[" & jj & "]/div/div/div/div[2]/div[1]/div[1]/div/div[1]/a").Attribute("href")
            'この段階でstScreenNameにはアカウントサイトのフルパスが入るので、余計な部分を省く
            Buf = Split(stScreenName, "/")
            stScreenName = Buf(UBound(Buf))
            
            Set cls = New Class1
            cls.Name = stNameBuf
            cls.ScreenName = stScreenName
            If Dic.Exists(stScreenName) Then
                '何もしない
            Else
                Dic.Add stScreenName, cls
            End If
        Next jj
        
        LoopCount = LoopCount + 1
        
        'せいいっぱいスクロールダウン
        driver.ExecuteScript ("window.scrollTo(0, document.documentElement.scrollHeight);")
        driver.Wait 1000
        Call CheckBrowser(driver)
        
        doHeight_Before = doHeight_Now
        doHeight_Now = driver.ExecuteScript("return document.documentElement.scrollHeight;")

'        If (Times = LoopCount) Then
'            Exit Do
'        End If
    Loop
    
    '辞書の内容をメモリ(変数Var)にいったん書き写す
    Keys = Dic.Keys
    ReDim Var(1 To UBound(Keys) + 1, 1 To 2)
    For jj = LBound(Keys) To UBound(Keys)
        Var(jj + 1, 1) = Dic(Keys(jj)).Name
        Var(jj + 1, 2) = Dic(Keys(jj)).ScreenName
    Next jj
    'メモリの内容をハードディスク(シート)に一気に書き込む
    ActiveSheet.Range(ActiveSheet.Cells(2, 2), ActiveSheet.Cells(2 + UBound(Keys), 4)).Value = Var
    
    Set divTag = Nothing
    Set oTag = Nothing
    Set Dic = Nothing
    Set cls = Nothing
End Sub

Private Sub CheckBrowser(ByVal driver As Object)
    Do While (StrComp("complete", driver.ExecuteScript("return document.readyState;"), vbTextCompare) <> 0)
        'Debug.Print "CheckBrowser:" & Now & "_" & driver.ExecuteScript("return document.readyState;")
        driver.Wait 1000
        DoEvents
    Loop
End Sub

Class1モジュール
Option Explicit

Public Name As String
Public ScreenName As String

注意

Seleniumが必要です。私はここのサイトを参考に、ダウンロードしました。

【2018年7月版】SeleniumBasicでMicrosoft Edgeを操作してみました。 | 初心者備忘録

↑こちらのサイトにも書いてありますが、ただSeleniumを入れただけではだめで、Edgeのドライバーを公式からダウンロードしてSeleniumのフォルダに入れ直す必要があります。

またPCにインストールされているMicrosoftEdgeのバージョンがドライバーと一致している必要があります。今回私はEdgeが少しだけ古かったので、Edgeを更新するひと手間もありました。

当然のことですが、公式のドライバーが更新されたら都度入れ替えが必要です。手間ですが、このコードは何回も使うつもりはないし、1回こっきりのつもりだったので、コードは汎用化せず、デバッグレベルの作成にとどめています。

途中にあるdriver.waitはSleepと同じです。これは3秒程度(3000)にしておくのがよいでしょうね。スクレイピングが迷惑行為と思われたらアカウント凍結の可能性もありますし、Twitterのサーバに負荷をかけないよう、控えめにアクセスするべきです。

Class1は辞書に登録するために作ったクラスモジュールです。メモリ上でデータを操作し、加工が全部終わってからExcelシートに書き込んだ方が早いので、私はいつもこんな風にしています。


VBAの使い方

Private Sub DoPageのところにブレークポイントを設けておき、シートでマクロを起動→ShowWebSite_DoTestを選択し実行します。


Edgeが立ち上がるので、いったんTwitterにログインします(ログインも自動化しようと思えばできたのですが、汎用化する必要もないので今回ははしょりました^^;)。

EdgeでTwitterにログインできたら、今回ゲットしたいアカウントのプロフィールページへ行き、フォローリストを表示します(コード上では私のサイトmob_sharoushi/followingになっていますが、自分の好きなアカウントのfollowingページでよいです)。ここまで表示できたら、VBEに戻ってF5キーを押します。

しばらく時間がかかります。私のPCとネット環境では、500件分取得するのに10分くらいかかりました。