VBA IE操作 YouTube動画から ブログ の本文を作成する サンプルとデバッグ

処理の流れ
^^^^^^^^^^
1.IE起動
2.B2に入力されたYoutubeのURLに飛ぶ
3.動画のタイトルをB1のセルに書き込む
4.動画の概要 説明欄を取り出し、リンクがあればリンクを細工する
5.動画投稿日をB25にセットする
6.キーワードを取り出しB3にセット
7.コメントを取り出す
8.二つ目のIEを起動してブログ作成画面を開く
9.タイトルをセットする
10.本文をセットする

11.まだ、手作業
確認して、投稿日を変更
ブログ投稿する

いつもの グダグタな解説動画
【VBA IE操作】指定したYouTube動画から はてなブログ の本文を作成する そんな転記プログラム【三流君】 - YouTube
www.youtube.com

下記、作成したソースコードです。

Option Explicit

'標準モジュールにAPI宣言を書く
Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
' https://www.moug.net/tech/acvba/0020028.html を 参考に
' 指定したウィンドウをフォアグラウンドウィンドウにする

Sub 詳細get()

    Application.WindowState = xlMinimized  'Excelを最小化する

    Dim objIE    As Object  'ＩＥオブジェクト参照用
    Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE.Top = 0
    objIE.Left = 0
    objIE.Visible = True '見えるようにする(お約束)
    Call SetForegroundWindow(objIE.hwnd)  '前面にIEを表示

    Dim n     As Integer
    Dim i     As Integer   '添え字 i番目などで使用
    Dim strWORK As String  '作業用スペース
    Dim yLINE As Integer   '行カウンタ、Y行目
    
    Dim objLI As Object
    Dim objUL As Object
  
    Range("A11:A20").ClearContents  'コメントエリアをクリアする
  
    '.Navigate で 指定した文字列のURLを開く
    objIE.navigate Range("B2")  'B2の調べたいURLに飛ぶ
    DoEvents

    '表示完了を待つ
    While objIE.readyState <> 4 Or objIE.Busy = True
        DoEvents  '特に何もしないで.Busyの状態が変わるまで待つ
    Wend
    
    Application.Wait (Now + TimeValue("0:00:05"))
       
    'タイトルをセットする
    Range("B1") = Replace(objIE.document.Title, " - YouTube", "")

    '説明のセット eow-description
    Dim eow_description As Object
    Dim objA As Object
    Dim strHREF As String
    
    Set eow_description = objIE.document.getElementByID("eow-description")
    strWORK = eow_description.InnerHTML
    'Aタグの修正
    For Each objA In eow_description.getElementsByTagName("a")
        Debug.Print objA.href
        strHREF = objA.href
        'リンク先URL を 書き換える
        strWORK = Replace(strWORK, objA.OuterHTML, "[" & strHREF & ":embed:cite]")
    Next
    
    '↑リンクアドレス修正
    Range("B25") = objIE.document.getElementByID("watch-uploader-info").InnerTEXT   'B25に日付
    Range("B26") = strWORK   'B26に説明セットする
        
    'keywords 区分のセット
    Debug.Print
    Debug.Print objIE.document.getElementsByName("keywords")(0).OuterHTML
    strWORK = objIE.document.getElementsByName("keywords")(0).OuterHTML
    n = InStr(strWORK, "content=")
    strWORK = Mid(strWORK, n, 9999)
    strWORK = Replace(strWORK, "content=""", "")  'content="を消す
    strWORK = Replace(strWORK, """>", "")  '後ろの">を消す
    Range("B3") = strWORK
    
'コメントを取り出す 最大10件
    'スクロールさせて、コメント欄を表示させる？
    SendKeys "{PGDN}"
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "{PGDN}"
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "{PGUP}"
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "{PGUP}"
    
    
    'Class で探して最大10件処理する
    Dim class_comment As Object
    Dim Comment_Cnt As Integer
    
    Comment_Cnt = 0
    For Each class_comment In objIE.document.getElementsByClassName("comment-renderer-text-content")
        Debug.Print class_comment.InnerTEXT
        'コメントをセルに書き込む A11～
        Cells(11 + Comment_Cnt, "A") = class_comment.InnerTEXT  'A列に書き込む
        Comment_Cnt = Comment_Cnt + 1
        If Comment_Cnt = 10 Then Exit For  '最大10件処理する
    Next
    
'ブックを保存する
    ActiveWorkbook.Save
    Application.WindowState = xlNormal

    'objIE.Quit

'はてなブログにタイトルと本文をセットする

    Dim objIE2    As Object  'ＩＥオブジェクト参照用
    Set objIE2 = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE2.Top = 100
    objIE2.Left = 200
    objIE2.Visible = True '見えるようにする(お約束)

    objIE2.navigate "https://blog.hatena.ne.jp/ken3memo/highnecked.hatenablog.jp/edit"
    While objIE2.Busy Or objIE2.readyState <> 4
        DoEvents
    Wend
    Call SetForegroundWindow(objIE2.hwnd)

    'BODYの取り出し
    Dim objBODY As Object   'HTMLBody
    Set objBODY = objIE2.document.body
    
    'タイトルをセットする
    '<input type="text" size="50" id="title" class="editor-title-input" name="title" placeholder="タイトル" value=""/>
    objBODY.all("title").Value = Range("b1").Text
    DoEvents

    '本文のセット
    Dim strBODY As String
    Dim y As Integer
    
    strBODY = ""
    For y = 6 To 26  '六行目から本文を作る
        If Cells(y, "B").Text <> "<li></li>" Then  '空白のリストを飛ばす
            strBODY = strBODY & Cells(y, "B").Text & vbCrLf  '改行付で作成する
        End If
    Next
    
    '  <textarea id="body" class="editor-body-textarea" name="body" cols="50" rows="15" placeholder="本文"></textarea>
    objBODY.all("body").Value = strBODY

    'MsgBox "テスト終了"

End Sub

※下記、冒頭と同じです
いつもの グダグタな解説動画
【VBA IE操作】指定したYouTube動画から はてなブログ の本文を作成する そんな転記プログラム【三流君】 - YouTube
www.youtube.com