#3 ExcelでYouTube動画を簡単リスト化！VBAとAPIで視聴回数ランキングを自動取得

K&S

「ExcelでYouTube動画のタイトルや視聴回数をリスト化してみたい！」と思ったことはありませんか？これまで、Excel VBAやAPIの利用は初心者には敷居が高いと感じられていました。しかし、今では ChatGPTにプロンプトを入力するだけで、実用的なツールが簡単に作れる時代 です！

この記事では、Excel VBAとYouTube Data APIを使って、YouTube動画の検索結果をリスト化するツールをゼロから作成する方法を解説します。VBAの専門知識がなくても大丈夫！この記事を読めば、以下のようなことが簡単にできるようになります：

  • メッセージボックスで検索ワードを入力し、APIを使って動画データを取得

  • 動画タイトル、URL、視聴回数をExcelにリスト化

  • 視聴回数順に動画ランキングを作成

このツールは、ChatGPTを活用してVBAコードを自動生成し、わずか数ステップで完成します。それでは早速、具体的な手順を見ていきましょう！

プロンプト

Excel VBAを使い、ユーザーが検索したYoutube動画のURLをリスト化したいです。
Youtube APIを使った取得の手順を教えて下さい。
以下の仕様として下さい。
・メッセージボックスから、検索ワード、検索数を入力
・A列：タイトル、B列：URL、C列：視聴回数
・視聴回数の多い順に取得
追加で必要なファイル、参照設定がある場合、手順を分かりやすく回答して下さい。

ChatGPT回答

Excel VBAを使ってYouTube動画の情報を取得する手順を以下に示します。このプロジェクトではYouTube Data APIを使用します。必要な設定とコードについても説明します。

必要な準備

1. Google Cloud Platform (GCP)でAPIキーを取得

  1. Google Cloud Consoleにアクセスし、Googleアカウントでログイン。

  2. 新しいプロジェクトを作成します（「プロジェクトを作成」ボタンをクリック）。

  3. APIとサービス > 有効なAPIとサービス > APIを有効にするを選択。

  4. 「YouTube Data API v3」を検索し、有効化します。

  5. 認証情報タブで「認証情報を作成」をクリックし、「APIキー」を選択。

  6. 発行されたAPIキーを控えておきます。

2. Excel VBAで参照設定を有効化

  1. Excelを開き、Alt + F11でVBAエディタを開きます。

  2. メニューから [ツール] > [参照設定] を選択。

  3. 以下のライブラリにチェックを入れます：

    • Microsoft Scripting Runtime

    • Microsoft XML, v6.0 または最新版

VBAコード

以下のコードをコピーして、VBAエディタに貼り付けてください。

Sub FetchYouTubeData()
    Dim apiKey As String
    Dim query As String
    Dim maxResults As Integer
    Dim apiUrl As String
    Dim http As Object
    Dim json As Object
    Dim items As Object
    Dim i As Integer
    Dim ws As Worksheet
    
    ' シートの準備
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Clear
    ws.Range("A1:C1").Value = Array("タイトル", "URL", "視聴回数")
    
    ' APIキーを設定
    apiKey = "XXXXXXXXXX" ' ←取得したAPIキーをここに貼り付け
    
    ' 検索条件を取得
    query = InputBox("検索ワードを入力してください:", "YouTube検索")
    If query = "" Then Exit Sub
    maxResults = InputBox("検索結果の最大数を入力してください:", "検索数", 10)
    If maxResults = "" Or Not IsNumeric(maxResults) Then Exit Sub
    
    ' APIリクエストURLの作成
    apiUrl = "https://www.googleapis.com/youtube/v3/search?" & _
             "part=snippet&type=video&order=viewCount&q=" & URLEncode(query) & _
             "&maxResults=" & maxResults & "&key=" & apiKey
    
    ' HTTPリクエストの実行
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", apiUrl, False
    http.Send
    
    ' レスポンスをJSONオブジェクトに変換
    If http.Status = 200 Then
        Set json = JsonConverter.ParseJson(http.responseText)
        Set items = json("items")
        
        ' 結果をシートに書き込む
        i = 2
        For Each item In items
            ws.Cells(i, 1).Value = item("snippet")("title") ' タイトル
            ws.Cells(i, 2).Value = "https://www.youtube.com/watch?v=" & item("id")("videoId") ' URL
            ws.Cells(i, 3).Value = "N/A" ' YouTube Data API v3では直接視聴回数を取得できない
            i = i + 1
        Next item
    Else
        MsgBox "APIリクエストに失敗しました: " & http.Status & " - " & http.statusText
    End If
End Sub

' URLエンコード関数
Function URLEncode(ByVal str As String) As String
    Dim i As Long
    Dim char As String
    Dim result As String
    For i = 1 To Len(str)
        char = Mid(str, i, 1)
        Select Case Asc(char)
            Case 48 To 57, 65 To 90, 97 To 122
                result = result & char
            Case Else
                result = result & "%" & Right("0" & Hex(Asc(char)), 2)
        End Select
    Next i
    URLEncode = result
End Function

追加手順

  1. コード中の "XXXXXXXXXX" に取得したAPIキーを貼り付けます。

  2. JsonConverter が必要です。以下の手順で取得してください。

    • VBA JSON から JsonConverter.bas ファイルをダウンロード。

    • VBAエディタで [ファイル] > [ファイルのインポート] を選択し、JsonConverter.bas をインポートします。

実行手順

  1. ExcelファイルでAlt + F8を押して「マクロ」を開きます。

  2. FetchYouTubeData を選択して「実行」。

  3. メッセージボックスに従い、検索ワードと検索数を入力。

  4. 結果がA列（タイトル）、B列（URL）、C列（視聴回数）に表示されます。

必要に応じてカスタマイズも可能です。問題があれば教えてください！

エラーが発生したため、改修を依頼するプロンプトを入力します。

プロンプト

If maxResults = "" Or Not IsNumeric(maxResults) Then 
ここで、”型が一致しません”というエラーが発生します。改修して下さい。

ChatGPT回答

そのエラーは、InputBox の返り値がキャンセルされた場合、空の文字列が渡されるために発生します。この問題を解消するためには、InputBox の返り値を適切に確認するロジックを追加する必要があります。

以下の修正済みコードをご覧ください：

Sub FetchYouTubeData()
    Dim apiKey As String
    Dim query As String
    Dim maxResults As Variant ' Variant型に変更
    Dim apiUrl As String
    Dim http As Object
    Dim json As Object
    Dim items As Object
    Dim i As Integer
    Dim ws As Worksheet
    
    ' シートの準備
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Clear
    ws.Range("A1:C1").Value = Array("タイトル", "URL", "視聴回数")
    
    ' APIキーを設定
    apiKey = "XXXXXXXXXX" ' ←取得したAPIキーをここに貼り付け
    
    ' 検索条件を取得
    query = InputBox("検索ワードを入力してください:", "YouTube検索")
    If query = "" Then
        MsgBox "検索ワードが入力されませんでした。処理を終了します。", vbExclamation
        Exit Sub
    End If
    
    maxResults = InputBox("検索結果の最大数を入力してください:", "検索数", 10)
    If maxResults = False Then
        MsgBox "検索数の入力がキャンセルされました。処理を終了します。", vbExclamation
        Exit Sub
    End If
    
    If Not IsNumeric(maxResults) Or Val(maxResults) <= 0 Then
        MsgBox "検索数には1以上の数値を入力してください。", vbExclamation
        Exit Sub
    End If
    
    ' APIリクエストURLの作成
    apiUrl = "https://www.googleapis.com/youtube/v3/search?" & _
             "part=snippet&type=video&order=viewCount&q=" & URLEncode(query) & _
             "&maxResults=" & Val(maxResults) & "&key=" & apiKey
    
    ' HTTPリクエストの実行
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", apiUrl, False
    http.Send
    
    ' レスポンスをJSONオブジェクトに変換
    If http.Status = 200 Then
        Set json = JsonConverter.ParseJson(http.responseText)
        Set items = json("items")
        
        ' 結果をシートに書き込む
        i = 2
        For Each item In items
            ws.Cells(i, 1).Value = item("snippet")("title") ' タイトル
            ws.Cells(i, 2).Value = "https://www.youtube.com/watch?v=" & item("id")("videoId") ' URL
            ws.Cells(i, 3).Value = "N/A" ' YouTube Data API v3では直接視聴回数を取得できない
            i = i + 1
        Next item
    Else
        MsgBox "APIリクエストに失敗しました: " & http.Status & " - " & http.statusText, vbExclamation
    End If
End Sub

' URLエンコード関数
Function URLEncode(ByVal str As String) As String
    Dim i As Long
    Dim char As String
    Dim result As String
    For i = 1 To Len(str)
        char = Mid(str, i, 1)
        Select Case Asc(char)
            Case 48 To 57, 65 To 90, 97 To 122
                result = result & char
            Case Else
                result = result & "%" & Right("0" & Hex(Asc(char)), 2)
        End Select
    Next i
    URLEncode = result
End Function

主な変更点

  1. maxResultsをVariant型に変更
    キャンセルや空文字列が返る可能性を考慮。

  2. キャンセル時のチェック
    InputBox の返り値が False の場合、処理を終了するように変更。

  3. 入力値の妥当性チェック
    IsNumeric で数値かどうかを確認し、Val(maxResults) <= 0 で正の整数かどうかもチェック。

  4. エラーメッセージ追加
    ユーザーが誤入力やキャンセルをした際にわかりやすいメッセージを表示。

これで問題が解消されるはずです！試してみてください。

視聴回数が取得できないため、改修を依頼します。

プロンプト

視聴回数が取得できていません。改修して下さい。

ChatGPT回答

YouTube Data API v3では、searchエンドポイントでは視聴回数を直接取得できません。視聴回数などの詳細情報を取得するには、videosエンドポイントを使用する必要があります。

以下の改修済みコードでは、検索結果から動画IDを取得し、それを使って視聴回数を含む詳細情報を取得する処理を追加しています。

改修済みコード

Sub FetchYouTubeData()
    Dim apiKey As String
    Dim query As String
    Dim maxResults As Variant ' Variant型に変更
    Dim searchUrl As String
    Dim videosUrl As String
    Dim http As Object
    Dim json As Object
    Dim searchItems As Object
    Dim videoItems As Object
    Dim videoIds As String
    Dim i As Integer
    Dim ws As Worksheet
    
    ' シートの準備
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Clear
    ws.Range("A1:C1").Value = Array("タイトル", "URL", "視聴回数")
    
    ' APIキーを設定
    apiKey = "XXXXXXXXXX" ' ←取得したAPIキーをここに貼り付け
    
    ' 検索条件を取得
    query = InputBox("検索ワードを入力してください:", "YouTube検索")
    If query = "" Then
        MsgBox "検索ワードが入力されませんでした。処理を終了します。", vbExclamation
        Exit Sub
    End If
    
    maxResults = InputBox("検索結果の最大数を入力してください:", "検索数", 10)
    If maxResults = False Then
        MsgBox "検索数の入力がキャンセルされました。処理を終了します。", vbExclamation
        Exit Sub
    End If
    
    If Not IsNumeric(maxResults) Or Val(maxResults) <= 0 Then
        MsgBox "検索数には1以上の数値を入力してください。", vbExclamation
        Exit Sub
    End If
    
    ' APIリクエストURLの作成 (searchエンドポイント)
    searchUrl = "https://www.googleapis.com/youtube/v3/search?" & _
                "part=snippet&type=video&order=viewCount&q=" & URLEncode(query) & _
                "&maxResults=" & Val(maxResults) & "&key=" & apiKey
    
    ' HTTPリクエストの実行 (searchエンドポイント)
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", searchUrl, False
    http.Send
    
    If http.Status = 200 Then
        Set json = JsonConverter.ParseJson(http.responseText)
        Set searchItems = json("items")
        
        ' 動画IDを収集
        videoIds = ""
        For Each item In searchItems
            videoIds = videoIds & item("id")("videoId") & ","
        Next item
        videoIds = Left(videoIds, Len(videoIds) - 1) ' 最後のカンマを削除
    Else
        MsgBox "APIリクエストに失敗しました: " & http.Status & " - " & http.statusText, vbExclamation
        Exit Sub
    End If
    
    ' APIリクエストURLの作成 (videosエンドポイント)
    videosUrl = "https://www.googleapis.com/youtube/v3/videos?" & _
                "part=snippet,statistics&id=" & videoIds & "&key=" & apiKey
    
    ' HTTPリクエストの実行 (videosエンドポイント)
    http.Open "GET", videosUrl, False
    http.Send
    
    If http.Status = 200 Then
        Set json = JsonConverter.ParseJson(http.responseText)
        Set videoItems = json("items")
        
        ' 結果をシートに書き込む
        i = 2
        For Each item In videoItems
            ws.Cells(i, 1).Value = item("snippet")("title") ' タイトル
            ws.Cells(i, 2).Value = "https://www.youtube.com/watch?v=" & item("id") ' URL
            ws.Cells(i, 3).Value = item("statistics")("viewCount") ' 視聴回数
            i = i + 1
        Next item
    Else
        MsgBox "APIリクエストに失敗しました: " & http.Status & " - " & http.statusText, vbExclamation
        Exit Sub
    End If
End Sub

' URLエンコード関数
Function URLEncode(ByVal str As String) As String
    Dim i As Long
    Dim char As String
    Dim result As String
    For i = 1 To Len(str)
        char = Mid(str, i, 1)
        Select Case Asc(char)
            Case 48 To 57, 65 To 90, 97 To 122
                result = result & char
            Case Else
                result = result & "%" & Right("0" & Hex(Asc(char)), 2)
        End Select
    Next i
    URLEncode = result
End Function

主な改修点

  1. videosエンドポイントを使用
    searchエンドポイントで取得した動画IDをもとに、videosエンドポイントから詳細情報（視聴回数など）を取得。

  2. statistics.viewCount を使用
    videosエンドポイントのレスポンスから視聴回数を取得してシートに書き込む。

  3. 動画IDの連結
    searchエンドポイントから取得した動画IDをカンマで連結してvideosエンドポイントに渡します。

これで視聴回数を正確に取得できます。試してみてください！

無事に取得出来ました！

検索ワード：Excel VBA ChatGPT
検索件数：20

まとめ

今回の記事では、Excel VBAとYouTube Data APIを活用して、YouTube動画の情報（タイトル、URL、視聴回数）を自動取得するツールを作成する方法を解説しました。特に注目したいのは、 ChatGPTを活用することで、複雑なコードも簡単に生成できる点 です。プロンプトを入力するだけで、これほど実用的なツールが作れるのは画期的ではないでしょうか？
このツールを応用すれば、動画ランキングの作成や、視聴回数のトレンド分析、さらにはマーケティングリサーチなど、さまざまな場面で活用できます。また、他のAPIとも組み合わせることで、さらに多機能なツールを作ることも可能です。
Excelは単なる表計算ソフトではなく、プログラミングや外部サービスと連携することで無限の可能性を秘めています。
ぜひ今回作成したツールを試してみてください！




いいなと思ったら応援しよう！