VBAで音声読み上げツール作成(Yahoo!ニュース読み上げ)

こんにちは、自動化エンジニアをしています。kozuです。

Webスクレイピング(Webページの情報を取得)の用途は色々ありますが、リアルタイム性が高い情報の場合、スクレイピングした結果を音声でアウトプットできたら便利ではないかと思いました。今回は例として「Yahoo!ニュース」の記事を読み上げるツールを作成します。

１．音声読み上げ方法

VBAの以下のコードで指定した文字列を読み上げすることができます。1行で実行できるので簡単ですね。OS標準の音声が使用されています。イントネーションに違和感がありますが、無料で使用できるものなので仕方ないです。GoogleやAmazon等の音声合成APIを使用すればより高品質で聞き取りやすい音声になりますが、また別の機会に試してみようと思います。

Call Application.Speech.speak("こんにちは")

２．操作手順

まず初めに「Yahoo!ニュース」のトップページを開きます。１枚目の画像の赤枠内の記事タイトルのリンクを全て取得し、リンクのURLから２枚目の画像のように記事のページに遷移します。遷移したページの赤枠のタイトルと文章を取得し、音声で読み上げます。「続きを読む」のリンクから情報量が多いページに遷移できますが、今回は概要だけ読み上げます。

３．IE操作の準備

標準モジュールを追加し、名前を「IEControl」としてください。こちらのコードをコピーしてください。

次に、参照設定を追加します。VBEの「ツール」→「参照設定」から、以下のライブラリを追加してください。
・Microsoft HTML Object Library
・Microsoft Internet Controls

４．VBAの実装

シートまたは新しく標準モジュールを追加し、以下のコードをコピーしてください。「Yahooニュース読み上げ」プロシージャを実行することでIEが起動し、Yahooニュースの記事の読み上げが行われます。

'YahooニュースURL
Const URL_YAHOO_NEWS As String = "https://news.yahoo.co.jp/"

'セレクタ(ニュース記事タイトルのリンク)
Const SELECTOR_NEWS_LINKS As String = "ul.topicsList_main li a"
'セレクタ(タイトル)
Const SELECTOR_TITLE As String = "p.pickupMain_articleTitle"
'セレクタ(記事本文)
Const SELECTOR_CONTENT As String = "p.pickupMain_articleSummary"


Public Sub Yahooニュース読み上げ()
   Dim objIE As New InternetExplorer
   
   'IEでURLのページを表示
   Call IEControl.OpenUrl(objIE, URL_YAHOO_NEWS)
   
   'ニュース記事のリンクを取得
   Dim newsLinks() As String
   newsLinks = GetNewsLinks(objIE, SELECTOR_NEWS_LINKS)
   
   Dim i As Integer
   For i = 0 To UBound(newsLinks)
       'リンクのページを表示
       Call IEControl.OpenUrl(objIE, newsLinks(i))
       
       '記事読み上げ
       Call SpeakNews(objIE)
   Next
   
   Call SpeakText("ヤフーニュースの読み上げが終了しました。IEをクローズします。")
   Call IEControl.CloseIE(objIE)
End Sub


'ニュース記事のリンクを取得
Private Function GetNewsLinks(ByVal objIE As InternetExplorer, ByVal selector As String) As String()
   Dim objNewsList As Object
   Set objNewsList = IEControl.GetHtmlObjByQuerySelectorAll(objIE, selector)
   
   Dim links() As String
   ReDim Preserve links(objNewsList.Length - 1) As String
   
   Dim i As Integer
   For i = 0 To objNewsList.Length - 1
       'リンクを取得
       links(i) = objNewsList.Item(i).href
   Next
   
   GetNewsLinks = links
End Function

'記事読み上げ
Private Sub SpeakNews(objIE)
   'タイトル
   Dim objTitle As Object
   Set objTitle = IEControl.GetHtmlObjByQuerySelector(objIE, SELECTOR_TITLE)
   Call SpeakText(objTitle.innerText)
   
   '本文
   Dim objContent As Object
   Set objContent = IEControl.GetHtmlObjByQuerySelector(objIE, SELECTOR_CONTENT)
   Call SpeakText(objContent.innerText)
End Sub

'テキスト読み上げ
Private Sub SpeakText(ByVal text As String)
   'テキスト置換
   text = ReplaceText(text)
   
   '読み上げ
   Call Application.Speech.Speak(text)
End Sub

'テキスト置換
Private Function ReplaceText(ByVal text As String) As String
   '置換するパターンを追加する
   text = Replace(text, "　", "。")
   text = Replace(text, "（", "かっこ")
   
   ReplaceText = text
End Function

５．処理の解説

「GetNewsLinks」プロシージャでニュース記事のタイトルリンクのオブジェクトを取得します。オブジェクトを1つずつ繰り返し、「href」でリンクのURLを取得し配列に格納します。
取得したリンクの配列の繰り返しでURLにアクセスし、「SpeakNews」プロシージャを呼び出します。このプロシージャでは、表示されたページのニュースのタイトルと文章を取得し「SpeakText」を呼び出し、引数に指定した文字列を読み上げます。
「SpeakText」内で呼ばれている「ReplaceText」では、文字列内に存在している言葉を置換しています。そのまま読み上げると不自然な箇所を別の言葉に置き換えています。とりあえずコード内で指定しているものは、スペースが含まれる場合は間を開けずに読み上げられるため、「。」に置換することで読み上げの間隔を開けて読み上げるようにしています。また、「（」がある場合、続けてカッコ中の言葉が読み上げられるため、「かっこ」に置換することで読み上げられたときにわかりやすくしています。他にもわかりにくく読み上げられる言葉がありましたら追加してください。