三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

XXXXXさんへ YouTubeのテキストエリアの書き出しの件 スクレイピング pythonで検索してみては? IE非推奨サイトが増えてきて寂しいなぁ

せっかく下記の質問をいただいたのに、誰でも思いつく検索ワードを紹介しただけだった・・・

>YouTubeのテキストエリアの書き出し
>ご教授くださいm(_ _)m
について

私の昔のサンプルだと、
VBA IE操作 例題:指定したYouTube動画から はてなブログ の本文を作成する そんな転記プログラム
今は、動作しないコードですが、
https://ken3code.hatenablog.jp/entry/2018/07/01/223940
を見て、参考になれば・・・

タイトルサムネイル

F12のDOMエクスプローラでIDやNameを探すのがポイントかなぁ
youtu.be
https://youtu.be/6yo4PJnzwk0?t=530
目次
00:00 0.あいさつ、やりたいこと
06:05 1.IE起動
06:49 2.B2に入力されたYoutubeのURLに飛ぶ
07:15 3.動画のタイトルをB1のセルに書き込む
08:29 4.動画の概要 説明欄を取り出し、リンクがあればリンクを細工する
08:50 DOMのIDを探すにはF12で要素の選択が便利です
16:36 5.動画投稿日をB25にセットする
20:16 6.キーワードを取り出しB3にセット
24:30 7.コメントを取り出す
30:34 8.二つ目のIEを起動してブログ作成画面を開く
31:41 9.タイトルをセットする
33:47 10.本文をセットする
36:50 11.まだ、手作業 本当は日時を選択させたかったけど・・・
38:35 再度、ポイントを繰り返し解説

YouTubeIE非対応になってから、時間がたつので、
現在、応用できるかわかりません。
お力になれずスミマセン。

今の流行は
google:スクレイピング python
なので、このキーワードで検索してみては?

google:スクレイピング python Youtube テキスト
で検索するとイロイロ出てきます。
https://www.youtube.com/watch?v=kvj3On1k66A
あっ、これだと、↑YouTubeスクレイピングでテキストを抜き出す解説動画がヒットするのか、、、

質問のYouTubeをターゲットにした
YouTube内のテキストを抜き出す
ズバリを検索することができなくてすみません。

YouTubeのテキストエリアを具体的に検索すると(コメント欄・説明・・・など)
見つかるかもしれません。

IE操作VBAが古い話になっていくことに寂しさを感じつつ
失礼します。 三流プログラマー Ken3




ken3code.hatenablog.jp
より
※今は動作しませんが、何かの参考となれば幸いです。

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  'IEオブジェクト参照用
    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  'IEオブジェクト参照用
    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

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)