ラベル Youtube の投稿を表示しています。 すべての投稿を表示
ラベル Youtube の投稿を表示しています。 すべての投稿を表示

VBA YouTubeの再生リストのURLを取得



YouTubeの再生リストのURLを取得


VBAを使ってYouTubeの再生リストのURL、タイトルを一括でエクセルシートに作成する方法です。
関数、メソッドなど
InternetExplorer.ApplicationオブジェクトとHTMLDocumentオブジェクトなどを使用します
ユーチューブの場合は直接HTMLDocument内を取得しようとするとうまくいかないので、IEを表示してHTMLドキュメント内を見ていきます。

そのほかには、Cells.Replaceメソッド、For Toのループ処理ぐらいです。


コード
Sub youtube_list()

'ツール→参照設定で「Microsoft HTML Object Library」にチェック入れる

Dim ws As Worksheet, i As Long, n As Long, r As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")

Dim document As Object
Dim objIE As Object
Dim htmlDoc As HTMLDocument
Dim url_list As String

'IEオブジェクトを作成
Set objIE = CreateObject("InternetExplorer.Application")


'inputboxを使用してURLをセット
url_list = InputBox(prompt:="url_list", Default:="")
objIE.Navigate url_list

'IEを表示
objIE.Visible = True

    '読み込むまでの処理
    While objIE.ReadyState <> 4 Or objIE.Busy = True
        DoEvents
    Wend
    
    'objIEで読み込まれているHTMLドキュメントをセット
    Set htmlDoc = objIE.document
  
    With ws
        'ヘッダー
        .Cells(1, 1) = "url"
        .Cells(1, 2) = "tittle"
        
            
            c = 0
            i = 2
            
            For n = 0 To htmlDoc.all.Length - 1
            
                With htmlDoc.all(n)
                    'リンクがあるタグのみ対象
                    If .tagName = "A" Then
                        'urlがあるclass
                        If .className = "pl-video-title-link yt-uix-tile-link yt-uix-sessionlink  spf-link " Then
                            'URL
                            ws.Cells(i, 1) = .outerHTML
                                '余計な部分を削除
                                ws.Cells(i, 1).Replace what:="&*", replacement:="", lookat:=xlPart, MatchCase:=False
                                ws.Cells(i, 1).Replace what:="*watch?v=", replacement:="", lookat:=xlPart, MatchCase:=False
                                
                            ws.Cells(i, 1) = "https://www.youtube.com/watch?v=" & ws.Cells(i, 1)
                            ws.Cells(i, 1).WrapText = False
                            'タイトル
                            ws.Cells(i, 2) = .innerText
                            ws.Cells(i, 2).WrapText = False
                            i = i + 1
                        End If
                    End If
                    
                End With
            
            Next n
            

    End With

'IE閉じる
objIE.Quit

End Sub

以上です。

解説
VBEの標準モジュールにそのまま貼れば動くとは思います。

inputボックスには再生リストのURLをそのままコピペします。(例、https://www.youtube.com/playlist?list=PLvMqQYhs_H1dSCGF20D5jUf_4AaJ50XF1)

再生リストのURLはAタグ(=リンクタグ)の中にあるので全てのタグの中からAタグを探し
If .tagName = "A" Then

そして、リンクの中でも再生用のURLはclassnameが"pl-video-title-link yt-uix-tile-link yt-uix-sessionlink spf-link "となっているので
 If .className = "pl-video-title-link yt-uix-tile-link yt-uix-sessionlink  spf-link " Then

で目的のURLを探しています。

あと、VBE上でツール→参照設定で「Microsoft HTML Object Library」にチェック入れてVBAでHTMLDocumentを使えるように設定が必要です。

関連・類似ページ
セルの文字列置換