ユーザIDからユーザ名などを取得する関数

現在のtwitterの仕様で機能する関数
仕様が変わったら動かなくなるはず。

Attribute VB_Name = "f_getTwitterStats"
#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


'Twitter関連の関数
'TwitterID からフォロワー数とユーザ名を取得する関数を取り合えず準備。
'Twitter側の仕様変更次第では関数自体使えなくなります。
'外部サイトのieViewとieCheckを関数内に記述し、遅延バインディングで書く

Public Function getTwitterStats(sTwitterID As String) As String

  'TwitterアカウントのTweet数、Following数、Followers数をカンマ区切りで列挙する関数
  '3つじゃない場合は想定外なので追って実装
  '存在しない場合は空文字を返す(IsNull/IsEmptyでは検出できない模様。 = "" だとTrueになる
  '16/8/31 数字の意味も追記した
  
  Dim objIE As Object
  Dim buf As String
  Dim i As Long
  Dim objtag As Object
  
  Set objIE = CreateObject("InternetExplorer.Application")

  buf = ""
    
'  Call ieView(objIE, "https://mobile.twitter.com/" & sTwitterID, False) http://www.vba-ie.net/code/ieview2.html
  'Stop
  With objIE
    .Visible = False
    .navigate "https://mobile.twitter.com/" & sTwitterID
  End With
  
  'ieCheck http://www.vba-ie.net/code/iecheck.html
  Dim timeOut As Date

  '完全にページが表示されるまで待機する
  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.Busy = True Or objIE.ReadyState <> 4
    DoEvents
    Sleep 1
    If Now > timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
  Loop

  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.document.ReadyState <> "complete"
    DoEvents
    Sleep 1
    If Now > timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
   Loop
  
'//ieCheck
'//ieView
  '氏名も取得する
  On Error Resume Next '実在しないIDの場合はエラーになるので処理をスキップ
  buf = objIE.document.getElementsByClassName("fullname")(0).innerText
  On Error GoTo 0
  For Each objtag In objIE.document.getElementsByTagName("div")
    If objtag.className = "statnum" Then
      If buf <> "" Then buf = buf & ","
      buf = buf & objIE.document.getElementsByTagName("div")(i + 1).innerText & ":" & CLng(objtag.innerText)

    End If
    i = i + 1
  Next
  objIE.Quit
  getTwitterStats = buf

End Function


Public Function getTwitterFollowers(sTwitterID As String) As Long
  '16/08/31 getTwitterStats から フォロワー数だけを取得する
  '「フォロワー」のキーワードを取得できなかった場合は0
  '何らかのエラーで取得できなかった場合は負のエラー番号を返す
  On Error GoTo Err_Trap
  Dim buf As String
  Dim buf2 As Variant
  buf = getTwitterStats(sTwitterID)
  If buf = "" Then Exit Function
  For Each buf2 In Split(buf, ",")
    If buf2 Like "フォロワー:*" Then
      getTwitterFollowers = Split(buf2, ":")(1)
      Exit Function
    End If
  Next buf2
  getTwitterFollowers = 0
  Exit Function
Err_Trap:
  getTwitterFollowers = -Err.Number
End Function

Public Function getTwitterFullName(sTwitterID As String) As String
  '16/08/31 TwitterID から ユーザ名を取得する
  'ユーザ名もgetTwitterStatsで取得できるようにしたのでそこから持ってくる
  getTwitterFullName = Split(getTwitterStats(sTwitterID), ",")(0)
End Function