投稿者 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