ネイティブが発音する英単語の発音記号とサウンドファイルを大量取得する
文系大学生概要
今回はエクセルのマクロ機能を使って、ネット上からデータやファイルを取得することをやってみました。（マクロプログラムの詳細については後日、独学プログラミングのページにアップするつもりです。）
具体的には、あらかじめエクセルに入力しておいた英単語を、オックスフォードの辞書サイトから発音記号とサウンドファイルを自動で入手するスクレイピングと呼ばれるものです。
アルクの究極の英単語を覚えようとしたときにネイティブの発音を聞きたかったことと、さらに究極の英単語をAnkiアプリに取り込んだときに発音記号も欲しかったことが、作ろうと考えた動機です。
Duo3.0を使っていて単語単体での発音を確認しておきたいという方も使っていただけると思います。
エクセルファイル
エクセルファイルはこちらからダウンロードしてください。
下準備
エクセルからインターネットエクスプローラーを開いて、ネットから情報やファイルを取得するには以下の簡単なセッティングが事前に必要です。
- エクセルの開発タブからVisual BasicタブをクリックしてMicrosoft Visual Basic for Applicationを開く
- Microsoft Visual Basic for Application のツールから参照設定を開く
- 参照設定ウィンドウが開くので、スクロールしながら頭文字Mを探し、その中から下記の2つのライブラリを見つけてチェックを入れる。
- Microsoft HTML Object Library
- Microsoft Internet Controls
- 以上で下準備は完了です。
知らない人の作ったマクロをダウンロードしたくない場合
知らない人の作ったマクロはコンピューターウィルスを含んでいる可能性があるため、ダウンロードしたくない方も大勢おられると思います。
ですので、下記にエクセルマクロの中身を添付しておきます。
モジュールへプログラムをペーストする
Microsoft Visual Basic for Applicationの標準モジュールを左クリックして、モジュールを用意する。これを4回繰り返してModule1～4を作り(下図を参照)、それぞれのモジュールに下記のプログラムをペーストします。
尚、変数は本来、半角英数字で定義すべきですが、初学者なのでプログラムの流れが理解しやすくなるので日本語で定義しています。後で検索・置換機能を使って変数をまとめて半角英数字に変換すると良いと思います。
Module1に下記のコードをペーストします。
'マクロ連続実行テスト
Sub スクレイピング連続実行マクロ()
' 連続で実行したいマクロプログラム(プロシージャー)をCallステートメントで呼び出す
Call Step1_発音記号とサウンドURL同時スクレイピングマクロ
Call Step2_サウンドファイルのダウンロードマクロ
' メッセージボックスで処理が完了したことを表示する
MsgBox "スクレイピング完了しました"
End Sub
Module2に下記のコードをペーストします。
' 指定時間だけマクロプログラムの実行を中断するためにMicrosoftが用意したプロシージャーを使うことを宣言しておく
Private Declare Sub Sleep _
Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Step1_発音記号とサウンドURL同時スクレイピングマクロ()
' 変数を一通り定義する
Dim 単語番号 As Integer ' 処理する行番号
単語番号 = 5 '5行目の単語から処理を開始する
Dim 単語 As String ' オックスフォードの辞書サイトで検索する単語
Dim 最終単語番号 As Integer ' 最終の行番号
最終単語番号 = Cells(Rows.Count, 2).End(xlUp).Row ' 2列目の一番下の行番号まで処理する
Dim ie As InternetExplorer ' InternetExplorer型のオブジェクト変数ieを用意する
Dim url 'オックスフォードのサイトのURL
Set ie = CreateObject("InternetExplorer.Application") ' オブジェクト変数にインターネットエクスプローラーをセットする
ie.Visible = False ' インターネットエクスプローラーの中身だけが欲しいので表示はさせない
On Error Resume Next ' エラーがあっても飛ばして次へ処理を進める。単語のスペルミスなどがあっても処理は継続される
' 5行目から最終行まで発音記号とサウンドファイルのURLの入手を繰り返し処理(Do Loop)する
Do
単語 = Worksheets("SVLデータ").Range("B" & 単語番号) ' ワークシート(ここではSVLデータと命名)のB列から単語を取得
url = "https://www.oxfordlearnersdictionaries.com/definition/english/" & 単語 '
ie.Navigate url
Call Sleep(10000) ' 冒頭で宣言したsleepプロシージャーで10秒処理を停止し、インターネットエクスプローラーの起動を待つ
' IEのページ読み込みが完了するのを待つ
While ie.Busy = True Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Wend
' IEが準備完了になるとreadyStateプロパティは4を返すので準備完了を判断する
Do While ie.ReadyState <> 4 Or ie.Busy = True
DoEvents
Loop
STime = Now
Do While DateAdd("S", 1, STime) > Now
DoEvents
Loop
'/////////////////////////////////////////////////////////////// 発音記号の取得 ////////////////////////////////////////////
Dim doc As HTMLDocument ' インターネットエクスプローラーで取得した中身を入れる変数docを定義
Set doc = ie.Document ' 変数docに中身を入れる
' このモジュールの最後に記載しているFunctionプロシージャー(自分で定義した処理)を使って、
' ページのhtmlを読み込んでphonというクラスに設定されている発音記号を取り出す
Dim 米国式発音記号
米国式発音記号 = doc.getElementsByClassName("phon")(1).innerText
米国式発音記号 = Replace(米国式発音記号, "/", "") ' 発音記号は/で挟まれているので/を取り除く
' ワークシートのC列に発音記号を記入する
Debug.Print 米国式発音記号
With Worksheets("SVLデータ")
.Range("C" & 単語番号) = 米国式発音記号
End With
'////////////////////////////////////////////////////////// サウンド・ファイルのURLの取得 ////////////////////////////////////
If Worksheets("SVLデータ").Range("C" & 単語番号) = "" Then ' 発音記号が取得できていることを確認してからサウンドファイルのURLを取得する
Else
Dim HTMLString As String ' オックスフォードのページ内のhtmlを入れる変数HTMLStringを用意
HTMLString = getHTMLString(ie) ' htmlを変数HTMLStringに入れる
Dim 米国式HTMLString
Dim 米国式発音はじめ
Dim 米国式発音おわり
' サウンドファイルのURLは必ずhttps://www.oxfordlearnersdictionaries.com/media/english/us_pron/から始まるので、
' その位置をInStr関数で探す
米国式発音はじめ = InStr(HTMLString, "https://www.oxfordlearnersdictionaries.com/media/english/us_pron/")
' サウンドファイルのURLより後ろの部分を米国式HTMLStringに入れる
米国式HTMLString = Mid(HTMLString, 米国式発音はじめ)
' 米国式HTMLStringの中でのサウンドファイルのURLが始まる文字の位置(つまり１)を米国式発音はじめに入れなおす
米国式発音はじめ = InStr(米国式HTMLString, "https://www.oxfordlearnersdictionaries.com/media/english/us_pron/")
' サウンドファイルのURLの表示から28文字後にclas="phon"の表示が必ず来るのでphoneの位置を米国式発音おわりに入れる
米国式発音おわり = InStr(米国式HTMLString, "phon")
' Mid関数でサウンドファイルのURLのはじめとおわりの文字位置を指定して取り出す
米国式発音 = Mid(米国式HTMLString, 米国式発音はじめ, 米国式発音おわり - 28)
Worksheets("SVLデータ").Range("D" & 単語番号) = 米国式発音 ' ワークシート(SVLデータ)のD列に記入
End If
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
単語番号 = 単語番号 + 1
' 変数の中身を空にしておく
米国式発音記号 = ""
米国式発音 = ""
If 単語番号 > 最終単語番号 Then Exit Do
Loop
End Sub
' オックスフォードのサイトのhtmlを文字列として取得するファンクション
Private Function getHTMLString(ie As InternetExplorer) As String
Dim htdoc As HTMLDocument
Set htdoc = ie.Document
Dim ret As String
ret = htdoc.getElementsByTagName("HTML")(0).outerHTML & vbCrLf
getHTMLString = ret
End Function
Module3に下記のコードをペーストします。
'// 指定URLファイルのダウンロード
Private Declare 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
'// キャッシュクリア
Private Declare Function DeleteUrlCacheEntry _
Lib "wininet" Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
'// スリープ
Private Declare Sub Sleep _
Lib "kernel32" (ByVal dwMilliseconds As Long)
'// URLを指定してDownloadFile関数を呼び出す
Sub Step2_サウンドファイルのダウンロードマクロ()
Dim 単語番号 As Integer
単語番号 = 5
Dim 最終単語番号 As Integer
最終単語番号 = Cells(Rows.Count, 2).End(xlUp).Row
Dim sUrl As String ' ダウンロード対象ファイルのURL
Dim ファイル名 As String
Dim N As Long, cnt As Long, cnt2 As Long 'サウンドファイルのURLからファイル名を抜き出すための変数
Dim path As String ' ダウンロードファイルを保存するローカルPCのフォルダのパス
path = Replace(Range("C1"), """", "") ' ワークシート(SVLデータ)のC1セルに入力したパスから"を除去して使用する
Dim sDir As String ' ダウンロードファイルを保存するローカルPCのファイルのパス（上記のパス+ファイル名）
' 5行目から最終行まで発音記号とサウンドファイルのURLの入手を繰り返し処理(Do Loop)する
Do
' URL設定
sUrl = Worksheets("SVLデータ").Range("D" & 単語番号)
N = InStr(1, sUrl, "/")
' /が何個あるかカウントする
Do While N > 0
cnt = cnt + 1
N = InStr(N + 1, sUrl, "/")
Loop
' 最後の/の位置でファイル名を切り出す
Do While cnt > cnt2
cnt2 = cnt2 + 1
N = InStr(N + 1, sUrl, "/")
Loop
N = N + 1
cnt = 0
cnt2 = 0
ファイル名 = Mid(sUrl, N)
sDir = path & "\" & ファイル名
Worksheets("SVLデータ").Range("E" & 単語番号) = ファイル名
' ダウンロード
Call DownloadFile(sUrl, sDir)
' 5秒スリープ
Call Sleep(5000)
単語番号 = 単語番号 + 1
If 単語番号 > 最終単語番号 Then Exit Do
Loop
End Sub
' 指定URLファイルのダウンロードを行う
Sub DownloadFile(a_sUrl As String, a_sDir As String)
Dim ret ' 戻り値
' キャッシュクリア
Call DeleteUrlCacheEntry(a_sUrl)
' ダウンロード
ret = URLDownloadToFile(0, a_sUrl, a_sDir, 0, 0)
' ダウンロード失敗時
If ret <> 0 Then
Debug.Print a_sUrl & "：ダウンロード失敗"
End If
End Sub
Module4に下記のコードをペーストします。
Sub リセット()
'
' リセット Macro
Dim last_row As Integer
last_row = Cells(Rows.Count, 2).End(xlUp).Row
Range("C5:E" & last_row).Clear
Range("A1").Select
End Sub
念のため、プログラムをペーストしたModuleの画像を添付します。
スイッチの取り付けと発音記号・サウンドファイル取得の実行
エクセルの開発から挿入を選択して、一番左上のボタンを選択する
ボタンを描画して左クリックで「マクロの登録」を選択
「マクロの登録」ウィンドウで「スクレイピング連続実行マクロ」を選択し、OKボタンを押して閉じる。
英単語をB列の3行目以降から入力し、スタートボタンを押す
後は放置しておけば発音記号とサウンドファイルがダウンロードされ、処理が完了すると「スクレイピングが完了しました」のメッセージボックスが表示されます。以上で完了です。
最後に
通信環境やパソコンの性能により、インターネットがプログラムに追い付かなくなるのを避けるため、要所要所で待機時間を数秒から10秒程度と少し長めに入れています。
待機時間を短くすると大量の英単を処理する場合などは時間短縮になります。
インターネットがエクセルの動作に追い付かなくならない程度に、通信環境にあわせて待機時間を調整してみるのも良いかもしれません。
