Excel VBAでYoutubeのサムネをダウンロードの作成してみた
この動画のマクロはWindows11/Office2016で作成してます。

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub Macro()
    Set fso = CreateObject("Scripting.FileSystemObject")
    CurrentDirectory = ThisWorkbook.Path
    
    download_dir = fso.BuildPath(CurrentDirectory, "thumbnail")
    If (fso.FolderExists(download_dir) = True) Then

        '// フォルダが存在する
        fso.DeleteFolder download_dir, True
    End If
    MkDir download_dir
    
    'ブラウザを起動
    Dim driver As New Selenium.WebDriver
    Set driver = CreateObject("Selenium.webDriver")


    driver.Start "chrome"
    driver.ExecuteScript ("Object.defineProperty(navigator, 'webdriver', {get: () => undefined})")
    
    '第2ディスプレイにブラウザを表示
    driver.Window.SetSize 750, 900
    driver.Window.SetPosition 2000, -700
    
    driver.Get "https://www.youtube.com/channel/UC1I8CiC80NrTrqb0yGqKLQg/videos"
    Call Sleep(2000)  '2秒待つ
    
    Set o_elem = driver.FindElementsByCss("a#thumbnail")
    For i = 1 To o_elem.Count
        a = Split(o_elem.Item(i).Attribute("href"), "=")
        If UBound(a) = 1 Then
            'Debug.Print a(1)
            ' http://img.youtube.com/vi/O-zqWNabYAc/sddefault.jpg
            th_url = "http://img.youtube.com/vi/" & a(1) & "/maxresdefault.jpg"
            res = URLDownloadToFile(0, th_url, fso.BuildPath(download_dir, a(1) & ".jpg"), 0, 0)
            
        End If
    Next

    'ブラウザを閉じる
    driver.Quit
    Set driver = Nothing
End Sub
カテゴリー: VBA

0件のコメント

コメントを残す

アバタープレースホルダー

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください