SeleniumVBAによる一括google翻訳

質問

色々試してみたのですが上手くいかないので、どうか皆様のお知恵をお貸しください。

・やりたいこと
エクセルのセルに入力された英文を、一括で和文に翻訳したい。
その一環として、アドインとしてSeleniumVBA(ver5.4)を使用し、英文(改行あり、長文の場合あり)をGoogle翻訳で翻訳、結果の和文を取得するコードを書いた。Chromedriverはver127.0.6533.99。

・問題点
一回なら問題ないが、複数連続で翻訳しようとすると、待機時間の問題からかエラーが出る(デバッグモードで暫く置いてから再開するとまた流れる)。
エラーの内容は、エクセルvba側で「実行時エラー500 ユーザープロファイルが読み込めません」、Google翻訳側で「翻訳エラーが発生しました」の二種類。
また、urlに翻訳文を張り付ける関係か、英文の空白が%20となり、うまく翻訳できない文章がある。

・教えてほしい点
ウェブページがちゃんと遷移するまで待機するコード。
翻訳前のテキストエリアに、翻訳したい英文を張り付けるコード(SendKeysで可能?)。
(もしエラーの対処が難しければ)エラーが出た時点で一定時間waitし、その後再開するコード。

・書いたコード
Dim Driver As SeleniumVBA.WebDriver

Private Sub Class_Initialize()
'chromeでgoogle頁を開く。
Set Driver = SeleniumVBA.New_WebDriver

Driver.StartChrome "D:\tool\その他\ExcelAddIn\chromedriver-win64\chromedriver.exe" 'Chromeをスタート。
Driver.OpenBrowser 'ブラウザを立ち上げる。

'翻訳を待つ最大時間を設定。
'https://bestrong-it-men.com/wait_method_for_selenium/
Driver.ImplicitMaxWait = 1000
'PageLoadの待機時間の最大値を設定。
'https://powervbadesktop.com/web43/
Driver.PageLoadTimeout = 2000
End Sub

Private Sub Class_Terminate()
Driver.CloseBrowser
Driver.Shutdown
End Sub

Public Function TranslateEn2JP(strSource As String) As String
'引数の文字列を立ち上げているgoogle翻訳で翻訳して日本語で返す。
'ClassNameは変わる事があるので、その場合は毎回調べる事。
Dim i As Long
Dim strClass As String
Dim webElems As WebElements '要素を借り受けする変数。
Dim strAry() As String '要素の内容を借り受けする変数。
Dim Rtn As String

'翻訳結果を取得するクラス名を設定
strClass = "ryNqvb"

'翻訳文が空白だった場合終了。
If Trim(strSource) = "" Then
Exit Function
End If

'URLに翻訳する文章を入れてgoogle翻訳のページを開く。
Driver.NavigateTo "https://translate.google.com/?sl=auto&tl=ja&text=" & strSource & "&op=translate"

'翻訳結果を取得。翻訳の結果が出るまでループ。
Do
Driver.Wait
Set webElems = Driver.FindElementsByClassName(strClass)
Loop While webElems.Count = 0
'改行は複数の要素に跨るので、それらを一つの文字列に結合する。
ReDim strAry(1 To webElems.Count)
For i = 1 To webElems.Count
strAry(i) = webElems.Item(i).GetText
Next i
Rtn = Join(strAry, vbCrLf)

'ひとつ前に戻って翻訳結果と履歴をクリア。
Driver.GoBack

TranslateEn2JP = Rtn
End Function

回答No.1

luka3

waitについては、こちらが参考になりそう
https://nkmrdai.com/selenium-wait-loading/

テキストエリアに英文を入力するには、上記サイトの例でXPathだと、

FWFlag = Driver.IsElementPresent(myBy.XPath("//*[@id="yDmH0d"]/c-wiz/div/div[2]/c-wiz/div[2]/c-wiz/div[1]/div[2]/div[2]/div/c-wiz/span/span/div/textarea"))

で入力用テキストエリアの表示待ちとなりますが、このXPathは自分の環境で試したもので、idがこれで固定なのかあやしいです。

ちなみにAIに聞いたところだと、

Dim wait As Object
Set wait = Driver.Wait(30) ' 最大30秒待機する WebDriverWaitオブジェクト
Driver.Get "https://translate.google.com/"
' テキストエリアに英文を入力
Dim textArea As Object
Set textArea = wait.Until(Driver.FindElementByCss("textarea[aria-label='原文']"))
textArea.Clear
textArea.SendKeys strSource
' 翻訳結果の要素が表示されるまで待つ
Dim resultElement As Object
Set resultElement = wait.Until(Driver.FindElementByCss("span[jsname='W297wb']"))
' 翻訳されたテキストを取得
translatedText = resultElement.Text

テキストエリアの指定は汎用性がありそうですが、翻訳結果はあやしいですね。

ちなみに、URLに埋め込む場合は
Application.WorksheetFunction.EncodeURL(strSource)
とすればいいようです。

お礼

回答ありがとうございます。
早速試してみます。