【VBA】ブラウザから英単語音声ファイルを一括ダウンロード

やりたいこと

・英語学習に使用する英語音声をブラウザからダウンロードする仕組みを自動化したい。
・流れは以下の通り
　　「テキストファイルから1行読み取り」
　　「読み取った文字列をブラウザに入力」
　　「ファイルをダウンロード」
　・今日日VBAでブラウザにアクセスするなど時代遅れかもしれないが、そこは気にしない。

ダウンロード先サイト

Sound Of Text

コード

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' マウスイベント
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Declare Sub mouse_event Lib "user32" ( _
    ByVal dwFlags As Long, _
    Optional ByVal dx As Long = 0, _
    Optional ByVal dy As Long = 0, _
    Optional ByVal dwDate As Long = 0, _
    Optional ByVal dwExtraInfo As Long = 0)

' 遷移先URL
Const TARGET_URL As String = "https://soundoftext.com/"

' 音声の保存先
Const OUTPUT_SOUND_PASS = "★★★\★★★\"

' メッセージ群
Dim inputMessage(1000) As String
Dim inputMessageCount As Long

Option Explicit

' エントリ関数
Sub Main()
  
  'IE(InternetExplorer)のオブジェクト変数を定義する。
  'このオブジェクトをするには「ツール」->「参照設定」にて
  '　１．Microsoft Internet Controls
  '  ２．Microsoft HTML Object Library
  'にチェックをつける必要がある。
  Dim objIE As InternetExplorer
  
  ' IE(InternetExplorer)のオブジェクトを作成する。
  Set objIE = CreateObject("InternetExplorer.Application")

  ' IE(InternetExplorer)を起動する。
  objIE.Visible = True
  
  ' フルスクリーンにする。
  Dim ret As Long
  ret = ShowWindow(objIE.hWnd, 3)
  
  ' 指定したURLへアクセスする。
  objIE.Navigate TARGET_URL
  
  ' 読み込みが完了するまで待機する。
  Call IEWait(objIE)

  ' マウスクリックによりスクロール
  Call ClickMouse(1910, 300)
  Sleep (3000)

  ' ファイルを読み込む。
  Call LoadFile

　' 英単語数分ループ
  Dim i As Long
  For i = 0 To inputMessageCount - 1
    Call DownloadSoundFile(objIE, inputMessage(i))
  Next
  
  ' アクティブウィンドウを閉じる。
  objIE.Quit
  Set objIE = Nothing
  
End Sub

' ファイルをダウンロードする。
Sub DownloadSoundFile(objIE As InternetExplorer, text As String)
    
  ' HTMLドキュメントオブジェクトを設定する。
  Dim htmlDoc As HTMLDocument
  Set htmlDoc = objIE.Document
     
  ' 英単語を入力
  ' valueの値書き換えだけでは正常に動作しない。
  ' おそらくonChangeなどが動的に呼ばれているため、直接キー入力する必要がある。
  Call ClickMouse(1000, 320)
  SendKeys text, True
  Sleep (200)

  ' Submitボタンを押下
  Call ClickMouse(1000, 500)
  Sleep (5000)
  
  ' 「ダウンロード」リンクを押下
  Call ClickMouse(800, 930)
  Sleep (2000)
    
  ' 名前を付けて保存を選択
  ' Alt + N -> Tab -> ↓ -> A
  SendKeys "%(n)", True
  Sleep (500)
  SendKeys "{TAB}", True
  Sleep (500)
  SendKeys "{DOWN}", True
  Sleep (500)
  SendKeys "A", True
  Sleep (1000)
  
  ' ファイルパスを設定して保存
  SendKeys OUTPUT_SOUND_PASS & text + ".mp3", True
  Sleep (100)
  SendKeys "{ENTER}", True
  Sleep (2000)
  
End Sub


' マウスをクリックする。
Sub ClickMouse(X As Long, Y As Long)
  ' 「ダウンロードバー」を閉じる。
  SetCursorPos X, Y
  mouse_event 2  '左ボタン押下のコード
  mouse_event 4  '左ボタン解放のコード
  Sleep (100)

End Sub

'
' テキストファイルを読み込む。
'
Sub LoadFile()
  Dim line As String
  inputMessageCount = 0
  
  ' ファイルの終端に至るまで一行ずつ読み込み。
  Open OUTPUT_SOUND_PASS & "_Input.txt" For Input As #1
  Do Until EOF(1)
    Line Input #1, line
    inputMessage(inputMessageCount) = line
    inputMessageCount = inputMessageCount + 1
  Loop
  Close #1

End Sub

書き換え必要な部位

・出力先ファイルパス : TARGET_URL
・ClickMouseの引数のスクリーン座標

速度

・確実に処理させるためSleepを多めに入れているためあまり早くない。
・約4ファイル / 分程度