【VBA】Excel for MacでYoutube Data Apiを使ってYouTube 動画コメントを全取得する

Last updated at 2021-01-28Posted at 2020-12-20

はじめに

これは、Visual Basic Advent Calendar 2020とSpreadsheets/Excel Advent Calendar 2020の21日目の記事となります。

前回、Windows 10環境の「【VBA】ExcelでYoutube Data Apiを使ってYouTube 動画コメントを全取得する」の記事を書きました。
Mac版のExcelにもVBAは使えるのですが、Windows版と違いActiveXが使用できないという弱点があります。

Office 365では、一つのライセンスでWindows、Mac含む5台のパソコンまでインストールする権利が含まれるようになりました。MacでVBAを使用する機会は今後増えてくるんじゃないかと思っています。

環境

MacOS big Sur 11.1
Excel for Mac ver 16.44 小売りライセンス 2019
VBA-JSON v2.3.1
VBA-Dictionary

VBA-JSON

VBAではJSONをパースする標準ライブラリがないので、VBA-JSONを利用します。
https://github.com/VBA-tools/VBA-JSON

Releasesから最新版(2020/12/19現在 v2.3.1)のVBA-JSONのリンクをクリックします。
Source code(zip) をダウンロードして展開します。
JsonConverter.basをVBAのプロジェクトにインポートします。
導入方法はVBAエディターを開き、プロジェクトウィンドウでVBAProjectを右クリックしファイルのインポートをクリックします。
標準モジュールにJsonConverterが表示されれば、VBA-JSONの導入は完了です。

図入りの説明が必要なら下記サイトを参照してください。
【VBA】Backlog APIで課題を操作する

VBA-Dictionary

Macでは「Microsoft Scripting Runtime」が使えません。用途としてはDictionary型を使用するためなので、VBA-Dictionaryを利用します。
https://github.com/VBA-tools/VBA-Dictionary

Releasesから最新版(2020/12/21現在 v１.4.1)のVBA-JSONのリンクをクリックします。
Source code(zip) をダウンロードして展開します。
Dictionary.clsをVBAのプロジェクトにインポートします。
導入方法はVBAエディターを開き、プロジェクトウィンドウでVBAProjectを右クリックしファイルのインポートをクリックします。
クラスモジュールにDictionaryが表示されれば、VBA-Dictionaryの導入は完了です。

仕様

コメントのフォーマットはhtmlかplain textがあるのですが、plain textになっています。
並び順はrelevanceで評価順が多い順にしています。子コメントについては順不動（並び順を指定しても動画サイトと同じにならない）です。

※APIの使用回数を減らすため親コメントはmaxResults=100、子コメントはmaxResults=50とする。
※コメントでは低評価(disLike)数は取得できない。

(連番)         (親コメント) （グッド数） （投稿者名） （投稿日時) （返信数)
(連番) (子連番) (子コメント) （グッド数） （投稿者名） （投稿日時)

使用方法

標準モジュールに、Constキーワードで'API_KEY'と'Video ID'を定義しているので変更してください。
VBAが出来る方なら、シートのセルに入力欄を作って変更できるようにすると楽になると思います。

Module1.bas

'ここにAPI KEYを入力
Const API_KEY = "(API KEYを入力)"

'ここにVideo IDを入力
Const VIDEO_ID = "(Video IDを入力)"

私は、Sheet2にコマンドボタンを用意して、クリックしたらCall GetYoutubeCommentを呼ぶようにしています。
それか、マクロ実行でGetYoutubeCommentを実行すればいいです。
Sheet１にコメントが出力されます。

API_KEYを入力

Youtube Data APIのAPI有効化の認証情報でAPIキーが発行されるので、プログラムのAPI_KEYを入力で発行されたAPIキーに書き換えてください。

Video IDを入力

例えば、「https://www.youtube.com/watch?v=oeJ_b0iG9lM」であれば、oeJ_b0iG9lMがVideo IDとなりますので、プログラムのVideo IDを入力で対象動画のVideo IDに書き換えてください。

プログラム

Module1.bas

Option Explicit

Const URL = "https://www.googleapis.com/youtube/v3/"

'ここにAPI KEYを入力
Const API_KEY = "(API KEYを入力)"

'ここにVideo IDを入力
Const VIDEO_ID = "(Video IDを入力)"

Sub コメント取得_Click()

    Call GetYoutubeComment

End Sub

' YouTube動画コメント全取得
Public Sub GetYoutubeComment()

    Dim row As Integer
    Dim header As Variant
    
    Sheets(1).Activate
    ActiveSheet.Cells.Clear
    
    ' ヘッダー
    header = Array("連番", "子連番", "コメント", "グッド数", "投稿者名", "投稿日時", "返信数")
    row = 1
    Call Output(row, ActiveSheet, header)
    
    Call GetComment(row, ActiveSheet)

End Sub

' コメント取得
Private Sub GetComment(ByVal row As Integer, ByVal sh As Worksheet)

    Dim no As Integer, cno As Integer, json As Object
    Dim text As String, like_cnt As Integer, user_name As String, post_date As Date
    Dim total_reply_cnt As Integer, parentID As String
    Dim params As Object, Item As Object
    Dim values As Variant
    
    Set params = New Dictionary
    
    With params
        .Add "key", API_KEY
        .Add "part", "snippet"
        .Add "videoId", VIDEO_ID
        .Add "order", "relevance"
        .Add "textFormat", "plaintext"
        .Add "maxResults", "100"
        .Add "pageToken", ""
    End With

    no = 1
    Do While True
        Set json = KickWebApiOfJson("GET", URL & "commentThreads", params)
    
        For Each Item In json("items")
            ' コメント
            text = CStr(Item("snippet")("topLevelComment")("snippet")("textDisplay"))
            ' グッド数
            like_cnt = CInt(Item("snippet")("topLevelComment")("snippet")("likeCount"))
            ' ユーザー名
            user_name = CStr(Item("snippet")("topLevelComment")("snippet")("authorDisplayName"))
            ' 投稿日時
            post_date = JsonDateToDate(Item("snippet")("topLevelComment")("snippet")("publishedAt"))
            ' 総返信数
            total_reply_cnt = CInt(Item("snippet")("totalReplyCount"))
            ' 親ID
            parentID = CStr(Item("snippet")("topLevelComment")("id"))
            
            values = Array(no, "", text, like_cnt, user_name, post_date, total_reply_cnt)
            Call Output(row, sh, values)
            
            If total_reply_cnt > 0 Then
                Call GetReplyComment(parentID, no, row, sh)
            End If
            no = no + 1
        Next
    
        params("pageToken") = CStr(json("nextPageToken"))
        If params("pageToken") = "" Then
            Exit Do
        End If
    Loop

End Sub

' 返信コメント取得
Private Sub GetReplyComment(ByVal parentID As String, ByVal no As Integer, ByRef row As Integer, ByVal sh As Worksheet)

    Dim cno As Integer, json As Object
    Dim text As String, like_cnt As Integer, user_name As String, post_date As Date
    Dim params As Object, Item As Object
    Dim values As Variant
    
    Set params = New Dictionary
    
    With params
        .Add "key", API_KEY
        .Add "part", "snippet"
        .Add "videoId", VIDEO_ID
        .Add "textFormat", "plaintext"
        .Add "maxResults", "50"
        .Add "pageToken", ""
        .Add "parentId", parentID
    End With

    cno = 1
    Do While True
        Set json = KickWebApiOfJson("GET", URL & "comments", params)
    
        For Each Item In json("items")
            ' コメント
            text = CStr(Item("snippet")("textDisplay"))
            ' グッド数
            like_cnt = CInt(Item("snippet")("likeCount"))
            ' ユーザー名
            user_name = CStr(Item("snippet")("authorDisplayName"))
            ' 投稿日時
            post_date = JsonDateToDate(Item("snippet")("publishedAt"))
            
            values = Array(no, cno, text, like_cnt, user_name, post_date)
            Call Output(row, sh, values)
            cno = cno + 1
        Next
    
        params("pageToken") = CStr(json("nextPageToken"))
        If params("pageToken") = "" Then
            Exit Do
        End If
    Loop

End Sub

' Excelシートに出力
Private Sub Output(ByRef row As Integer, ByVal sh As Worksheet, ByVal values As Variant)

    Dim i As Integer

    For i = 0 To UBound(values)
        sh.Cells(row, i + 1).Value = values(i)
    Next
    row = row + 1

End Sub

' JSON日付変換
Private Function JsonDateToDate(ByVal dt As String) As Date

    JsonDateToDate = CDate(Replace(Mid(dt, 1, 16), "T", " "))
    
End Function

' クエリ文字列変換
Private Function ConvertToQueryString(ByVal dic As Object) As String

    If dic Is Nothing Then Exit Function
    Dim Key As Variant
    Dim str As String
    str = ""
    For Each Key In dic.Keys
        ConvertToQueryString = ConvertToQueryString & str & Key & "=" & dic.Item(Key)
        str = "&"
    Next

End Function

' WebAPI取得
Function KickWebApiOfJson(ByVal request As String, ByVal URL As String, Optional ByVal param As Object) As Object
    Dim json
    json = ConvertToQueryString(param)

    Dim http As String
    Dim command As String

    command = "do shell script ""curl --get -d '" & json & "' " & URL & """"
    http = MacScript(command)
    
    If http <> "" Then
        Set KickWebApiOfJson = ParseJson(http)
    End If
End Function

Windows版との違い

Dictionary型

Windowsでも、VBA-Dictionaryを使用するなら「New Dictionary」で大丈夫です。

Set params = CreateObject("Scripting.Dictionary")
             ↓
Set params = New Dictionary

MSXML2.ServerXMLHTTP

MacではActiveXが使用できないため、「MSXML2.ServerXMLHTTP」が使えません。
Excel for Mac (VBA) から HTTP GET する方法

Dim http As Object
Set http = CreateObject("MSXML2.ServerXMLHTTP")
↓
Dim http As String
Dim command As String

command = "do shell script ""curl --get -d '" & json & "' " & URL & """"
http = MacScript(command)

MacとWindowsの分岐

今回はMacとWindowsの分岐まではやらなかったですが、コンパイラ定数を使用すればMacとWindowsで共用のプログラムを作ることができます。
他にもMacとWindowsの違いで気を付ける箇所は幾つかあるようです。
MacでVBAを書く時の注意
 コンパイル時に Office for Mac のバージョンを区別する

#If Mac Then
    Set params = New Dictionary
#Else
    Set params = CreateObject("Scripting.Dictionary")
#End If

実行結果

郡司りかさんを御存知でしょうか？
マツコ・デラックスさんと村上信五（関ジャニ∞）さんがMCの「月曜から夜更かし」の中で、運動音痴として注目を浴びた女性です。
郡司りかさんはYoutubeとTwitterをやられており、ツイート画像に「おはよー」を隠すという遊びをしています。
郡司りかさんのツイート画像の「おはよー」を見つける

「【NiziU】郡司さんMake You Happyにチャレンジ (練習前)」の動画コメントを取得すると、下記のようになります。

最後に

私は2020年1月にMacを購入した際にOfficeを小売ライセンス購入したのですが、Office 365のライセンスを調べていれば、WindowsとMacの両方が使えるのでOffice 365にすれば良かったかな思いました。
前記事のWindows版は30日までの試用期間のOffice 365上で作成しました。30日経過後どうするか検討します。
【2021/01/28追記】
検討の結果、Office 365は試用期間で留めておきました。

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up