ExcelVBA IE自動化においてBasic認証画面のOKボタンを押したい

VBAでIE自動化を行っています。
目的のサイトはログイン時にBasic認証があり、以下URL先のページを参考にコードを組みました。
https://www.vba-ie.net/collection/iebasic.php

※以下コードは、サイト様からの抜粋です。

VBA
1
2Sub sample()
3
4    Dim objIE As InternetExplorer
5
6    'Basic認証（ベーシック認証）ページへアクセスする
7    Call ieBasic(objIE, "http://www.vba-ie.net/basic/test3.html", "dXNlcjoxMjM0NTY=")
8
9End Sub
10
11Sub ieBasic(objIE As InternetExplorer, _
12            urlName As String, _
13            idPass As String)
14            
15    Dim headValue As String
16
17    'IEのオブジェクトを作成する
18    Set objIE = CreateObject("InternetExplorer.Application")
19    
20    'IEを表示
21    objIE.Visible = True
22    
23    'Authorization情報
24    headValue = "Authorization: Basic " & idPass & vbCrLf
25  
26    '指定したBasicURLのページを表示する
27    objIE.navigate urlName, , , , headValue
28 
29    'IEが完全表示されるまで待機
30    Call ieCheck(objIE)
31
32End Sub

BASE64エンコードも正しく行い、一度目の認証はクリアしてログイン画面まで到達したのですが、
ログインボタンを押した後、再度Basic認証画面が出てきました。

上記サイト様の注意書きにもあるように、Basic認証は２つ出る場合があり、
２つ目の制御には直接キーを送信するSendkeyくらいしかないようなことが書かれていますが、
UI Automation値を取得するAccExplorerを使用して確認したところ、ウインドウとOKボタンが取得できており、
試しにAccExplorerの[Do It]ボタンを押すとOKが押されました。

ハンドルを全取得するツールを使用しても取得できなかったウインドウタイトルやクラス名が判明したため、
ウインドウハンドルを取得して、OKと名の付く値を押すよう、以下のコードを組みました。

▼OKボタンのパラメーター
ウインドウタイトル："Windows セキュリティ"
ウインドウクラス　："Credential Dialog Xaml Host"
ボタンタイトル　　："OK"

VBA
1    Dim objIE As InternetExplorer
2    Dim t As String
3    Dim o As Object
4    Dim objDocument As Object
5    Dim hwnd As LongPtr
6  　Dim uiAuto As CUIAutomation
7  　Dim elmIE As IUIAutomationElement
8  　Dim elmNotificationBar As IUIAutomationElement
9  　Dim elmSaveSplitButton As IUIAutomationElement
10  　Dim elmSaveDropDownButton As IUIAutomationElement
11  　Dim elmSaveMenu As IUIAutomationElement
12  　Dim elmSaveMenuItem As IUIAutomationElement
13  　Dim elmIEDialog As IUIAutomationElement
14  　Dim elmSaveAsButton As IUIAutomationElement
15  　Dim elmSaveAsWindow As IUIAutomationElement
16  　Dim elmFileNameEdit As IUIAutomationElement
17  　Dim elmSaveButton As IUIAutomationElement
18  　Dim elmNotificationText As IUIAutomationElement
19  　Dim elmCloseButton As IUIAutomationElement
20  　Dim iptn As IUIAutomationInvokePattern
21  　Dim vptn As IUIAutomationValuePattern
22
23  　Const ROLE_SYSTEM_BUTTONDROPDOWN = &H38&    
24    Call ieBasic(objIE, ログインページのURL, BASE64エンコード文字列=ベーシック認証ユーザー名,ベーシック認証パスワード)
25    Call wait(objIE)
26    
27    Dim htmlDoc As HTMLDocument
28    Set htmlDoc = objIE.document
29    
30    On Error Resume Next
31    htmlDoc.getElementsByName("username")(0).Value = ユーザー名
32    htmlDoc.getElementsByName("password")(0).Value = パスワード
33    htmlDoc.getElementsByClassName("login-button")(0).Click
34    
35    Sleep 5000
36    
37    hwnd = FindWindow("Credential Dialog Xaml Host", "Windows セキュリティ")
38    Set uiAuto = New CUIAutomation
39    Set elmIE = uiAuto.ElementFromHandle(hwnd)
40    
41    '''Set objDocument = IEDOMFromhWnd(hwnd)
42    'ソースの確認
43    ''''Debug.Print objDocument.body.innerHTML
44    
45    Dim hButton As Long
46    hButton = FindWindowEx(hwnd, 0&, "Credential Dialog Xaml Host", "OK")
47    
48    Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
49    Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする
50    
51    '[Internet Explorer]ダイアログ((ファイル名) で行う操作を選んでください)取得
52    Do
53    Set elmIEDialog = _
54      GetElement(uiAuto, _
55                 elmIE, _
56                 UIA_NamePropertyId, _
57                 "Credential Dialog Xaml Host", _
58                 UIA_WindowControlTypeId)
59    DoEvents
60    Loop Until (Not elmNotificationBar Is Nothing) Or _
61             (Not elmIEDialog Is Nothing)
62
63    Do
64    Set elmSaveAsWindow = _
65      GetElement(uiAuto, _
66                 uiAuto.GetRootElement, _
67                 UIA_NamePropertyId, _
68                 "OK", _
69                 UIA_WindowControlTypeId)
70    DoEvents
71    Loop While elmSaveAsWindow Is Nothing
72    
73    Set elmSaveButton = _
74    GetElement(uiAuto, _
75               elmSaveAsWindow, _
76               UIA_NamePropertyId, _
77               "OK", _
78               UIA_ButtonControlTypeId)
79    If elmSaveButton Is Nothing Then Exit Sub
80    Set iptn = elmSaveButton.GetCurrentPattern(UIA_InvokePatternId)
81    iptn.Invoke

Basic認証のウインドウハンドルは取得できているのですが、
最初のDoでループから抜けてくれません（以下部分）。

VBA
1    Do
2    Set elmIEDialog = _
3      GetElement(uiAuto, _
4                 elmIE, _
5                 UIA_NamePropertyId, _
6                 "Credential Dialog Xaml Host", _
7                 UIA_WindowControlTypeId)
8    DoEvents
9    Loop Until (Not elmNotificationBar Is Nothing) Or _
10             (Not elmIEDialog Is Nothing)

どこが間違っているのか見当がつかず、こちらにご相談させていただきました。
何かヒントになるようなことでも構いませんので、お教えいただけるとありがたいです。
どうか宜しくお願いいたします。

追記：2019/08/22 10:50

お伝えし忘れていました。
以下部分のコードは、UI Automationとは別の方法でボタンを押そうとしている処理です。
ウインドウハンドルは取得できていますが、ボタンが取得できていません。
変数hButtonの中身を見ると、0が代入されていました。

VBA
1    hwnd = FindWindow("Credential Dialog Xaml Host", "Windows セキュリティ")
2    Set uiAuto = New CUIAutomation
3    Set elmIE = uiAuto.ElementFromHandle(hwnd)
4    
5    '''Set objDocument = IEDOMFromhWnd(hwnd)
6    'ソースの確認
7    ''''Debug.Print objDocument.body.innerHTML
8    
9    Dim hButton As Long
10    hButton = FindWindowEx(hwnd, 0&, "Credential Dialog Xaml Host", "OK")
11    
12    Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
13    Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする
14

追記：2019/08/26 16:13

開発環境

Windows10 x64
Office Excel 2013 x86

行動規範の内容に同意します

回答2件

ボタンのハンドル(hButton)は採取できていますか?

掲示されているAccExplorerのウィンドウツリーをみるとOKボタンは
トップレベルウィンドウから2階層下にあるように思います。
これに対し、FindWindowEXは指定したハンドル直下の子ウィンドウ
しか採取できないようですので、孫ウィンドウを得るには、
FindWindowEXを2回繰り返す必要があるのではないでしょうか?

投稿2019/08/26 02:30

h.horikoshi

総合スコア505

GoogleWindows

2019/08/26 07:16

h.horikoshi様ご回答ありがとうございます。 hButtonは何度やっても取得できませんでした。なるほど、階層というものが存在するのですね。けれど、取得できているハンドルはすべて同一で、 title名とclass名は恐らく一階層下のものを取っていると思われます。下の階層を得るには、FindWindowEXを２回繰り返すというと見当がつかないのですが、何か参考になりそうなページはあるでしょうか。検索しても今回のケースのようなものが出てきません。

GoogleWindows

2019/08/26 07:19

UI Automationの画像を追加いたしましたのでご覧ください。

h.horikoshi

2019/08/26 08:52

UI Automationの画像ありがとうございます。これ見てもどのウィンドウか私にはよくわかりません(汗)が、このツールはハンドルは確認できるのですか? 私はウィンドウツリーを調べるのにWinspector というフリーソフトを使っています。これだとツリー上にハンドルが表示されますので、これでツリーを表示し、並行してFindWindowEXを動かして得られたハンドルを比較する。という方法でウィンドウを特定しています。 >何か参考になりそうなページはあるでしょうか。あまりジャストなものはありませんが、たとえば以下のページでは下位層のウィンドウを得るために再帰処理を行なっています。 http://s-kita.hatenablog.com/entry/20121218/1355839657 なお、トップレベルウィンドウの配下のウィンドウを一括して(孫以下も含めて)検索するのであれば、EnumChildWindows という関数もあります。これだと階層を気にする必要がありません。 ※コールバック関数を作る必要があるので若干面倒ですが。

GoogleWindows

2019/08/26 13:07

ご連絡ありがとうございます。 Winspectorもそうですが、ダイアログの場合、基本的にハンドル取得という概念で作られているソフトでは、ウインドウハンドルくらいしか取れません。 WindowsフォームアプリケーションならばEnumChildWindowsで中の要素を孫まで取れるのですが。 UI Automationは、ダイアログや通知バー、WPFアプリケーションの要素を取得する際に使うようです。せっかく参考の情報をご提供くださったのに申し訳ありません。

行動規範の内容に同意します

私が達人養成塾で習った
Base64エンコード関数を使ってみてください。

VBA
1' 名　称 : EncodeBase64 by 小川慶一
2' 機　能 : Base64エンコード
3' 引　数 : 文字列
4' 戻　値 : Base64エンコードされた文字列
5'------------------------------------------------------
6'Required: Microsoft XML, v6.0
7
8Private Function EncodeBase64(st As String) As String
9    Dim arrData() As Byte
10    arrData = StrConv(st, vbFromUnicode)
11    
12    Dim objXML As MSXML2.DOMDocument60
13    Dim objNode As MSXML2.IXMLDOMElement
14    
15    Set objXML = New MSXML2.DOMDocument60
16    Set objNode = objXML.createElement("b64")
17    
18    objNode.DataType = "bin.base64"
19    objNode.nodeTypedValue = arrData
20    EncodeBase64 = objNode.Text
21    
22    Set objNode = Nothing: Set objXML = Nothing
23End Function

呼出方法は以下の通り

VBA
1Sub Main()
2    headValue = "Authorization: Basic " & EncodeBase64(sId & ":" & sPass)
3    objIE.navigate urlName, , , , headValue
4End Sub

---追記：2019/08/23 22:59
VBAのSendKeysは安定しないので、WshShellオブジェクトのSendKeysを試してみてください。
メモ帳を起動して文字を送る事例を紹介しますので、参考にしてください。

VBA
1'参考サイト：Windows管理者のためのWindows Script Host入門
2'第5回 WshShellオブジェクトの詳細(1)(4 / 4)
3'http://www.atmarkit.co.jp/ait/articles/0407/08/news101_4.html
4
5'②WshShellオブジェクトのSendKeysで記録
6Sub memo_txt2()
7    Dim rc As Long
8    rc = Shell("notepad.exe", vbNormalFocus)
9    DoEvents
10    Debug.Print rc
11    If rc = 0& Then
12        MsgBox "メモ帳の起動に失敗しました。"
13        Exit Sub
14    End If
15    
16    With CreateObject("Wscript.Shell")
17        Do Until .AppActivate("無題 - メモ帳")
18            DoEvents
19        Loop
20    
21        Dim sMessage As String
22        sMessage = "WshShellオブジェクトのSendKeysで記録されました。"
23        If Len(sMessage) <> LenB(StrConv(sMessage, vbFromUnicode)) Then
24            '日本語の場合、クリップボードへ入れてCTRL+v
25            Call CopyToClipboad2(sMessage)
26            .SendKeys "^v" '小文字にすべし
27        Else
28            .SendKeys sMessage
29        End If
30    End With
31End Sub

VBA
1'クリップボードへ文字列を格納する関数（改良版）
2'https://www.excel-chunchun.com/entry/AutoFilterPlus#クリップボード関連
3
4Private Sub CopyToClipboad2(ByVal strInput As String)
5    With CreateObject("Forms.TextBox.1")
6        .MultiLine = True
7        .Text = strInput
8        .SelStart = 0
9        .SelLength = .TextLength
10        .Copy
11    End With
12End Sub

投稿2019/08/22 13:48

編集2019/08/23 13:59

TanakaHiroaki

総合スコア1065

GoogleWindows

2019/08/22 14:50 編集

TanakaHiroaki様素晴らしい関数をご提供いただき、ありがとうございます。早速、以下のようにコーディングして走らせました。 ```VBA 　Dim headValue As String 　Dim urlName As String 'IEのオブジェクトを作成する Set objIE = CreateObject("InternetExplorer.Application") 'IEを表示 objIE.Visible = True 　　urlName = ターゲットサイトURL 　　'Basic認証（ベーシック認証）ページへアクセスする headValue = "Authorization: Basic " & EncodeBase64(Basic認証ID & ":" & Basic認証PASS) objIE.navigate urlName, , , , headValue 'IEが完全表示されるまで待機 Call ieCheck(objIE) Dim htmlDoc As HTMLDocument Set htmlDoc = objIE.document On Error Resume Next htmlDoc.getElementsByName("username")(0).Value = LoginID htmlDoc.getElementsByName("password")(0).Value = LoginPASS htmlDoc.getElementsByClassName("login-button")(0).Click headValue = "Authorization: Basic " & EncodeBase64(Basic認証ID & ":" & Basic認証PASS) objIE.navigate urlName, , , , headValue 'IEが完全表示されるまで待機 Call ieCheck(objIE) Call wait(objIE) ``` しかし、残念ながら２度目の認証を突破できませんでした。私の記述がよろしくないのでしょうか？ログインボタンを押した後に認証を求められるため、２度目のタイミングとしては間違えていないと思うのですが。是非、ご意見をいただけたらと思います。

TanakaHiroaki

2019/08/22 15:37

ここから先は自信がないです。以下のように改行コードを追加し、Base64エンコードする方法も試してみてください。 headValue = "Authorization: Basic " & EncodeBase64(Basic認証ID & ":" & Basic認証PASS & vbCrLf) 'headValue = "Authorization: Basic " & EncodeBase64(Basic認証ID & ":" & Basic認証PASS)

GoogleWindows

2019/08/23 00:31

ご連絡ありがとうございます。改行コードを導入させていただいたのですが、残念ながら２度目のBasic画面に反応はありませんでした。 Base64エンコードの場合、基本的にIEが立ち上がると同時に処理させなければ通らないのでしょうか。 Basic認証画面が可視化されている状態だと、Base64エンコードで通すのが難しいように思います。今回いただいたコードを走らせた際も、新規でページを開いて１度目の認証を取り直しているような印象でした。 Sendkeyの%o（Alt+Oキー）ならOKボタンを押せましたが、ウインドウにフォーカスが当たってなければならないし NumLockが押されたり押されなかったりのバグはあるし、ほとんど使い物になりません。 SendMessageでAlt+oキーを同時に押そうとしても、個別に送信されてしまいます。 Call PostMessage(hwnd, WM_SYSCHAR, &H12, 0) Call PostMessage(hwnd, WM_IME_CHAR, Asc("o"), 0) Call PostMessage(hwnd, WM_IME_KEYDOWN, &H12, 0) Call PostMessage(hwnd, WM_IME_KEYDOWN, &H4F, 0) Call PostMessage(hwnd, WM_IME_KEYUP, &H4F, 0) Call PostMessage(hwnd, WM_IME_KEYUP, &H12, 0) 色々と試しましたが、ダメでした。やはりUI Automationに頼るしかなさそうです。

GoogleWindows

2019/08/24 08:39

新たなコードをご提案いただき、ありがとうございます。しかし、ダイアログのウインドウハンドルが、必ずOKボタンの生成前に取得できてしまい、 Sleepをかけなければなりません。 OKボタンのオブジェクトが生成されるまでループして待機する処理を入れようとも思いましたが、そもそもOKボタンの値が判明していないのでそれもできず、やはりOKボタンをねらい打ちして押さなければ安定した処理にはならないと考えています。せっかくご提案いただいたのに申し訳ありません。

TanakaHiroaki

2019/08/24 08:57

そうですか。私ではお手上げです。すみません。

行動規範の内容に同意します

あなたの回答