WordでTwitterをやる方法（適用編）

人の三大欲求といえば

・食欲

・性欲

そして

Twitter欲、そう人は睡眠を犠牲にしてでも何故かTwitterを開いてしまうように出来ているものです。

その欲望は当然授業中でも発現します。でも講義中に堂々とTwitterの画面を開けない人は多いでしょう、ならばそんな状況でTwitterをするにはどうしたらいいか。

WordでTwitterが出来るようにすればいいのです。Wordを開いているだけなら傍から見ても講義のメモを取っているようにしか見えません。

さて、実際にWordでTwitterをする方法を説明していきます。まず、以下のコードをコピーしましょう。

（力業で書いてます汚いかもだけど許して、デバッグが面倒だったのでエラーが出ても無視するコードを突っ込んでるけど許して）

Option Explicit
Private stopT As Boolean
Sub Twitter()
'
' Twitter Macro
'
'
    
    Dim buf As Integer
    buf = InputBox("何ツイート取得しますか？")
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    Call gettweet(buf, IE)
    ActiveDocument.Range(0, 0).Select
    IE.Quit
    Set IE = Nothing
End Sub
Sub autoTwitter()
'
' autoTwitter Macro
'
'
    Dim buf As Integer
    buf = InputBox("何ツイート取得しますか？")
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    stopT = False
    Do
        Call gettweet(buf, IE)
        ActiveDocument.Range(0, 0).Select
        'if
        Call WaitFor(60)
        Selection.WholeStory
        Selection.Delete Unit:=wdCharacter, Count:=1
        If stopT Then Exit Do
    Loop
    IE.Quit
    Set IE = Nothing
End Sub
Sub stopTwitter()
    stopT = True
End Sub
Sub gettweet(ByVal num As Integer, ByRef IE As Object)
    
    IE.Navigate "https://twitter.com/"
    Call IEWait(IE)
    Dim temp As String
    Dim tweet_temp As String
    Dim name As String
    Dim subg As String
    temp = IE.Document.body.innerHTML
    tweet_temp = temp
    Dim i As Integer
    For i = 1 To num
        On Error Resume Next:
        tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "suggest_ranked_organic_tweet"))
        On Error Resume Next:
        tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "data-name=""") + 11)
        On Error Resume Next:
        name = Mid(tweet_temp, 1, InStr(tweet_temp, """") - 1)
        Selection.TypeText name & vbLf
        'TweetTextSize
        tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "TweetTextSize"))
        On Error Resume Next:
        tweet_temp = Mid(tweet_temp, InStr(tweet_temp, ">") + 1)
        On Error Resume Next:
        subg = Mid(tweet_temp, 1, InStr(tweet_temp, "<") - 1)
        Selection.TypeText subg & vbLf & vbLf & vbLf & vbLf
    Next
End Sub


Function IEWait(ByRef objIE As Object)
    Do While objIE.Busy = True Or objIE.ReadyState <> 4
        DoEvents
    Loop
End Function
Function WaitFor(ByVal second As Integer)
    Dim futureTime As Date
 
    futureTime = DateAdd("s", second, Now)
 
    While Now < futureTime
        DoEvents
    Wend
End Function

このコードの説明についてはまた新しく記事を書くかもしれません。

これをWordのマクロに貼り付けるだけといえばだけなんですが、まずWordにはデフォルトでマクロを編集出来る「開発」タブが表示されていないんですよね。しかもそこを説明しろと言われたのでちゃんと説明します。

なので、とりあえず今日はじめてWordを使う人向けくらいの丁寧な説明を心がけます。

まず、開発タブの出し方

Wordの右端のグレーの部分の空白の所で右クリックします。

そこで「リボンのユーザー設定」とかいうのをクリックします。

表示されるウィンドウの「リボンのユーザー設定」の部分で「開発」というところにチェック✓をつけましょう。OKを押たら開発タブが表示されてると思います。

この開発タブをクリックして「マクロ」の部分をクリックします。マクロ名に適当な名前を入れて作成をクリックします。

何かウィンドウが表示されたと思うので、そこに書いてあるものを全部消すか最後に追加するか適当に選んでさっきのコピーしたコードを貼り付けてください。（ただし一番最初の行のOption Explicitについては一番上に書き換えといてください。）

これでこのマクロ編集ウィンドウを閉じます。これでTwitterをやるマクロの適用は終わりです。

実際使ってみる

まず下準備としてInternet ExplorerでTwitterにログインし、そのログイン状態を保存しておく必要があります。

次に一度マクロをクリックすると「autoTwitter」と「Twittter」、「stopTwitter」というマクロが出来てると思います。

「Twitter」マクロについて、これを実行すると

みたいまウィンドウが表示されるので取得したいTweet数を入力してOKを押すとその数だけのTweetがWordに入力されます。（現在画像とハッシュタグは無視します）

こんな感じ

こんな感じで今のところガバガバ実装だから画像とハッシュタグは無視される pic.twitter.com/F8PIQ31cLD

— いろは_なの (@iroha_nano145) 2019年6月12日

 「autoTwitter」マクロについて、これを実行すると「Twitter」と同じようなインプットボックスが表示されます。すると1分ごとにその数だけのTweetを取得してWordに入力し古いのは消すというのをずっと繰り返します。（これも現在画像とハッシュタグは無視します）終了するときは同じようにマクロから「stopTwitter」を実行するとループが停止します。

さて、使い方分かってもらえたでしょうか。もし分からない所や感想などがあれば気軽にコメントしてください。筆者が喜びます。

 ※なおこのコードについて

ことりちゅん (id:Kotori-ChunChun)さんから多大なるアドバイスを頂いて改善させて頂きました。本当にありがとうございます。以下にことりちゅん (id:Kotori-ChunChun)さんが提案していただいたコードを引用させて頂きます。詳しくはこの記事のコメントを参照してください。こちらの方が使い勝手がいいと思います。

ことりちゅん (id:Kotori-ChunChun)

と、言ったは良いものの、autoTwitterの方は色々おかしいですね。
objIE.Quitの破棄がLoopより前にあるので2巡目以降は動きません。
マクロを中断させるとiexplore.exeがタスクとしてたまり続けてしまうのでちょいと危険です。

私なりに整理してみましたのでご参考まで。

'https://strelka-dog.hatenablog.com/entry/2019/06/15/233948

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Private Const READYSTATE_UNINITIALIZED = 0 'デフォルト値。未完了状態。
Private Const READYSTATE_LOADING = 1 'IEオブジェクトのロード中状態。
Private Const READYSTATE_LOADED = 2 'IEオブジェクトのロード完了状態。ただし操作不可能状態。
Private Const READYSTATE_INTERACTIVE = 3 'IEオブジェクトの操作可能状態。
Private Const READYSTATE_COMPLETE = 4 'IEオブジェクトの全データ読み込み完了状態。

Private IsExit As Boolean

Function IEWait(ByRef objIE As Object)
Do While objIE.Busy Or objIE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Sleep 100
Loop
End Function

'---コード2-2｜指定した秒だけ停止する関数---
Function WaitFor(ByVal second As Long)
Dim futureTime As Date

futureTime = DateAdd("s", second, Now)

While Now < futureTime
DoEvents
Sleep 100
Wend
End Function

Sub autoTwitter()

'取得ツイート数
Dim tweetCount As Variant
tweetCount = InputBox("何ツイート取得しますか？")
If Not IsNumeric(tweetCount) Or tweetCount <= 0 Then Exit Sub

'待ち時間
Dim waitSecond As Variant
waitSecond = InputBox("何秒ごとに更新しますか？　0の時：更新しない。負荷を避けるため10秒切り上げします。")
If Not IsNumeric(waitSecond) Then Exit Sub
If waitSecond > 0 And waitSecond < 10 Then waitSecond = 10

Debug.Print "START", Format(Now, "hh:mm:ss")

'IEオブジェクト　※Twitterに自動ログインできる状態であること
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate "https://twitter.com/"
Call IEWait(objIE)

Dim i As Long
Dim temp As String
Dim tweet_temp As String
Dim name As String
Dim subg As String

'終了フラグ（終了時はstopTwitterにてTrueを上書きすること）
IsExit = False

Do
'Word上の文章を全て削除
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1

Debug.Print "LOAD", Format(Now, "hh:mm:ss")

'HTMLを取得
On Error Resume Next
temp = objIE.Document.body.innerHTML
On Error GoTo 0
tweet_temp = temp

'HTMLを解析し出力
On Error Resume Next
For i = 1 To tweetCount
tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "suggest_ranked_organic_tweet"))
tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "data-name=""") + 11)
name = Mid(tweet_temp, 1, InStr(tweet_temp, """") - 1)
Selection.TypeText name & vbLf
'TweetTextSize
tweet_temp = Mid(tweet_temp, InStr(tweet_temp, "TweetTextSize"))
tweet_temp = Mid(tweet_temp, InStr(tweet_temp, ">") + 1)
subg = Mid(tweet_temp, 1, InStr(tweet_temp, "<") - 1)
Selection.TypeText subg & vbLf & vbLf & vbLf & vbLf
Next
ActiveDocument.Range(0, 0).Select
On Error GoTo 0

If waitSecond <= 0 Then Exit Do

'ブラウザを更新
objIE.Refresh
Call IEWait(objIE)

Call WaitFor(CLng(waitSecond))

If IsExit Then Exit Do
Loop

'IEオブジェクト破棄
On Error Resume Next
objIE.Quit
Set objIE = Nothing
On Error GoTo 0

End Sub

Sub stopTwitter()
IsExit = True
Debug.Print "STOP", Format(Now, "hh:mm:ss")
End Sub