【UIAutomation】UIツリー構造の揺れについて

タグの編集
投稿者 kake  (社会人) 投稿日時 2023/1/10 02:46:26
初めて投稿いたします。
当方、現在Excel VBAでUIAutomationを勉強中の者です。

現在勉強として、エクセルA列に複数行記載されている英文を1行ずつコピーして、Edgeで開いたDeepL(Web翻訳サイト)に貼り付け、出力された訳文をエクセルB列に順次転記していく、
というスクリプトを作成しております。

ひとまず開発用メインPCでの実装と動作検証はうまくいったのですが、OSが違うサブPCで検証するとうまく動作しなかったため確認したところ、Inspect上のUIツリー構造がメインPCとサブPCで1段ズレていることが分かりました。(サブPCの方が1段多くなってる)
メイン/サブPCのOSはそれぞれWin11, Win10で、Edgeのバージョンはどちらも最新です。

この場合、OSごとにコードを書き分けるしか対処法は無いでしょうか?
またUIAutomationを使用したスクリプトは一般的に、こういったOSやバージョンの変化に弱いものなののでしょうか?
恐れ入りますが、ご教示をいただけますと大変幸いです。


【メインPC  OS: Win11】
⊟"" メイン
 ┣⊟"毎日、何百万もの人々がDeeplで翻訳・・・" 
 ┗⊟"" グループ
    ┗⊟"" タブパネル
       ┣⊞"テキストの翻訳" 見出し
       ┣⊟"" グループ
       ┃ ┣⊟"原文" 地域
           ┣⊞"原文" 見出し
           ┣⊞"" グループ
           ┣⊞"" グループ
           ┗⊟"" グループ
              ┣⊞"" グループ
              ┣⊟"" グループ
              ┃  ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)


【サブPC   OS: Win10】
⊟"" メイン
 ┣⊟"毎日、何百万もの人々がDeeplで翻訳・・・" 
 ┗⊟"" グループ
    ┗⊟"" タブパネル
       ┣⊞"テキストの翻訳" 見出し
       ┣⊟"" グループ
       ┃ ┣⊟"原文" 地域
           ┣⊞"原文" 見出し
           ┣⊞"" グループ
           ┣⊞"" グループ
           ┗⊟"" グループ
              ┣⊞"" グループ
              ┣⊟"" グループ
              ┃  ┗⊟"原文" グループ   
                     ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)




以下はメインPCで動作確認できているコードになります。
補助コメントが多いので見づらく申し訳ございませんが、併せてご確認いただけますと幸いです。

Option Explicit

'参考:https://yaromai.jp/vba-uiautomation/

Sub kido_deepl()
  CreateObject("WScript.Shell").Run "msedge.exe -url " & "https://www.deepl.com/translator"
End Sub

Sub honyaku_deepl()

  '前の処理で残ってる訳文をクリア ※1行目は見出し、2行目から原文(A列)・訳文(B列)

  Range(Cells(2, 2), Cells(Rows.Count, 2)).ClearContents
  
  'UIAutomationに使う各種オブジェクトを宣言
  Dim uiAuto As CUIAutomation  '検索/クリック/入出力等の各種操作を行うための大元のオブジェクト
  Dim uiCnd As IUIAutomationCondition '要素の検索条件を設定するためのオブジェクト
  Dim uiElm As IUIAutomationElement '要素を検索するためのオブジェクト
  Dim uiElm_root As IUIAutomationElement '要素を検索するためのオブジェクト -> root(デスクトップ)取得専用
  Dim uiElm_deepl As IUIAutomationElement '要素を検索するためのオブジェクト -> DeepL取得専用
  Dim uiInv As IUIAutomationInvokePattern '要素をクリックするためのオブジェクト
  Dim uiVal As IUIAutomationValuePattern '要素に値を入力したり、要素から値を出力するためのオブジェクト

  '通常の変数宣言
  Dim i As Long, inputText As String, transText As String, prevText As String
  
  'デスクトップ要素を取得
  Set uiAuto = New CUIAutomation
  Set uiElm_root = uiAuto.GetRootElement()
  
  'DeepL(メイン)要素を取得 (デスクトップから直接の原文/訳文の要素を検索してもいけるが、検索負荷を減らす目的でDeepL画面を経由してる)
  Set uiCnd = uiAuto.CreatePropertyCondition(UIA_AutomationIdPropertyId, "dl_translator")
  Set uiElm_deepl = uiElm_root.FindFirst(TreeScope_Descendants, uiCnd)
  
  '処理を個数分ループ
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  
    ' ▼▼ 原文入力 ▼▼
    '"原文"欄の要素を取得
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__source_textarea lmt__textarea_base_style")
    Set uiElm = uiElm_deepl.FindFirst(TreeScope_Descendants, uiCnd)
    
    '"原文"欄に文字列を入力
    Set uiVal = uiElm.GetCurrentPattern(UIA_ValuePatternId)
    If i = 2 Then
      uiVal.SetValue "" '初回のみブランク入力(前に処理したときの訳文が残ってると狂うので)
      Application.Wait Now() + TimeValue("00:00:01")  'ブランクの原文→訳文反映までちょっと待機 Do Loopで訳文=""を判定した方が確実かも
    End If
    uiVal.SetValue Cells(i, 1).Value 'Excel A列→DeepLに原文入力
    
    ' ▲▲▲▲▲▲▲▲▲
    
    ' ▼▼ 訳文出力 ▼▼
    '"訳文"欄の要素を取得
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__target_textarea lmt__textarea_base_style") 'dl_disableがついてエラーになるときがあるので注意 "lmt__textarea lmt__target_textarea lmt__textarea_base_style dl_disabled"
    Do '処理速くてSetミスる時があるので、できるまでループ
      Set uiElm = uiElm_deepl.FindFirst(TreeScope_Descendants, uiCnd)
    Loop While uiElm Is Nothing
    
    Do '新しい翻訳結果を取得できるまでループ
      Set uiVal = uiElm.GetCurrentPattern(UIA_ValuePatternId)
      transText = uiVal.CurrentValue  'CurrentValueで今選択してる要素(ここでは訳文欄)の文字列を取得できる
    Loop While prevText = transText
    
    Cells(i, 2) = transText 'B列に訳文を出力
    prevText = transText
    ' ▲▲▲▲▲▲▲▲▲
  
  Next i

End Sub
投稿者 魔界の仮面弁士  (社会人) 投稿日時 2023/1/10 17:42:00
> 'DeepL(メイン)要素を取得 (デスクトップから直接の原文/訳文の要素を検索してもいけるが、検索負荷を減らす目的でDeepL画面を経由してる)
 
検索負荷を減らすためなら、UIAutomation を使うのではなく、
正規の DeepL API を呼び出すべきなのでは…?

Option Explicit

Public Function Translate_English_To_Japanese(ByVal Text As StringAs String
    Translate_English_To_Japanese = Translate("EN""JA", Text)
End Function
Public Function Translate_Japanese_To_English(ByVal Text As StringAs String
    Translate_Japanese_To_English = Translate("JA""EN", Text)
End Function

'https://www.deepl.com/ja/docs-api/glossaries/ 
Private Function Translate(ByVal sourceLang As StringByVal targetLang As StringByVal Text As StringOptional ByVal AuthKey As String = YOUR_AUTH_KEY) As String
    Dim strReq As String
    strReq = "text=" & Replace(WorksheetFunction.EncodeURL(Text), "%20""+")
    If sourceLang <> "" Then strReq = strReq & ("&source_lang=" & sourceLang)
    If targetLang <> "" Then strReq = strReq & ("&target_lang=" & targetLang)
    
    Dim xDoc As MSXML2.XMLHTTP60
    Set xDoc = New MSXML2.XMLHTTP60
    xDoc.Open "POST""https://api-free.deepl.com/v2/translate?" & strReq, False
    xDoc.setRequestHeader "Authorization""DeepL-Auth-Key " & AuthKey
    xDoc.send
    If xDoc.Status = 200 Then
        'この JSON の .translations.text 部に訳文が入っている 
        Dim rawJson As String
        rawJson = xDoc.responseText

        '本来は JSON 用のライブラリで読み取った方が良い 
        Dim translated As String
        translated = Split(rawJson, """", 10)(9)
        translated = Left(translated, Len(translated) - 4)
        translated = Replace(translated, "\\""\")
        translated = Replace(translated, "\r", vbCr)
        translated = Replace(translated, "\n", vbLf)
        translated = Replace(translated, "\t", vbTab)

        Translate = translated
    Else
        Debug.Print xDoc.Status, xDoc.statusText
        Translate = vbNullString
        'Stop 
    End If
End Function
投稿者 魔界の仮面弁士  (社会人) 投稿日時 2023/1/10 23:55:42
> 【メインPC  OS: Win11】
>  ┣⊟"" グループ
>  ┃  ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)


> 【サブPC   OS: Win10】
>  ┣⊟"" グループ
>  ┃  ┗⊟"原文" グループ   
>         ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)

手元の Win10/Win11 で試しましたが、いずれも前者の階層構造に見えました。

OS の違いというよりは、コンテンツ側の Dynamic HTML (というか JavaScript) によって
DOM 階層が動的に変化しただけでは無いでしょうか。


> それぞれWin11, Win10で、Edgeのバージョンはどちらも最新です。
手元の Edge バージョンは下記のものです。

Win11 + Microsoft Edge バージョン 108.0.1462.76 (公式ビルド) (64 ビット)
Win10 + Microsoft Edge バージョン 109.0.1518.44 (公式ビルド) beta (64 ビット)
Win10 + Microsoft Edge バージョン 110.0.1587.0 (公式ビルド) dev (64 ビット)
Win10 + Microsoft Edge バージョン 110.0.1612.0 (公式ビルド) canary (64 ビット)


> こういったOSやバージョンの変化に弱いものなののでしょうか?
Edge は AutomationId や ClassName が付与されるので、
Chrome に比べれば楽だと思いますよ。

https://vb-user.net/junk/replySamples/2023.01.10.23.42/EdgeUIAutomation.png

ただ、HTML コンテンツの読み取りなら、UIAutomation を使うよりも WebDriver の方が
辿りやすいです。また、公式の API が用意されているものはそちらを用いるべきでしょう。


> 【サブPC   OS: Win10】
>  ┣⊟"" グループ
>  ┃  ┗⊟"原文" グループ   
>         ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)

階層が増えたという「"原文" グループ」の ClassName は何でしたか?
投稿者 魔界の仮面弁士  (社会人) 投稿日時 2023/1/11 00:59:40
> '"原文"欄の要素を取得
> Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__source_textarea lmt__textarea_base_style")

原文側が非アクティブな場合は
 "lmt__textarea lmt__source_textarea lmt__textarea_base_style"
ではなく、
 "lmt__textarea lmt__source_textarea lmt__textarea_base_style lmt__textarea--inactive"
になる可能性がありますが、今回のケースなら大丈夫かな…?


> Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__target_textarea lmt__textarea_base_style") 'dl_disableがついてエラーになるときがあるので注意 "lmt__textarea lmt__target_textarea lmt__textarea_base_style dl_disabled"

いっそのこと、dl_disabled 付きと dl_disabled 無しの両方を拾うための
IUIAutomationOrCondition を用いるのはどうでしょうか。
Win10 v1809 以降であれば、検索条件に MatchSubstring パラメーターを追加する手も使えるかも。

※ dl_disabled の有無が切り替わるときに Handle何某Event が飛ぶかどうかは未確認です。
投稿者 kake  (社会人) 投稿日時 2023/1/11 12:30:38
魔界の仮面弁士 様
ご確認・ご回答頂き誠にありがとうございます。
こんなにも詳細に、且つその他の対処方法についてもご教示頂き本当に嬉しい限りです。

取り急ぎ下記にのみお返事させていただきます。

> 【サブPC   OS: Win10】
>  ┣⊟"" グループ
>  ┃  ┗⊟"原文" グループ   
>         ┗⊡"原文" 編集  (←ここのValueに原文の文字列が入ってる)

階層が増えたという「"原文" グループ」の ClassName は何でしたか?

➡ClassNameは"lmt__textarea lmt__source_textarea lmt__textarea_base_style focus-visible-disabled-container"でした。
  AutomationIdはブランクです。一度頂いた画像の通りに整理してみようと思います。