特定のYouTubeチャンネルの動画をすべてリストアップするSeleniumBasic+Excel VBAマクロ


Sub Main()
    
    Dim driver As New ChromeDriver
    Dim elmLoop As WebElement
    Dim cURL    As New Collection
    Dim lUrlCount As Long
    Dim KBDKeys As New Keys
    
    
    On Error Resume Next
    With driver
        
        .Get "https://www.youtube.com/c/DrivingJapan/videos?view=0&sort=dd"
        
        .Wait 1000 * 5
        
        '最後の動画まですべて表示させる
        Do
            lUrlCount = .FindElementByCss("ytd-grid-renderer").FindElementsByTag("A").Count
                
            .FindElementByTag("body").SendKeys KBDKeys.End
            .Wait 1000 * 5
            
        Loop While lUrlCount <> .FindElementByCss("ytd-grid-renderer").FindElementsByTag("A").Count
        
        Dim fp As Integer
        fp = FreeFile
        
        '保存する場所=ExcelのWorkBookが保存されているフォルダ
        Open Application.Workbooks(1).Path & "\" & "YoutubeList.txt" For Output As #fp
        
        '動画URLが含まれている可能性のある部分の全Aタグを走査する
        For Each elmLoop In .FindElementByCss("ytd-grid-renderer").FindElementsByTag("A")
            sURL = elmLoop.Attribute("HREF")
            Err.Clear
            cURL.Add Key:=sURL, Item:=cURL '2重登録回避チェック
            
            If Err = 0 Then
                If InStr(sURL, "https://www.youtube.com/watch?v=") Then
                    Print #fp, sURL
                End If
            End If
        Next
        Close #fp
    End With
End Sub

コメント

タイトルとURLをコピーしました