通知バーから発出されるダイアログボックスまで制御してファイルを保存したい

IEまたはIEモードから発出される独自の黄色い通知バーを制御して「名前を付けてファイルを保存する」を実行するマクロを作りました。
個人的にはタブのタイトルで名前つけて保存を実行したいので引数はタブタイトルにしました。
使い方
通知バーが表示されるウィンドウ名を指定して実行する。
この時DownloadFileNotificationBar の引数にFrame Notification Barのハンドルと
ファイル名をフルパスで指定する。
なお、上書き保存には対応していないので注意です。
Option Explicit

Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" _
(ByVal hwnd&, _
ByVal wMsg&, _
ByVal wParam&, _
ByVal lParam&) As LongPtr

Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                    ByVal lpClassName As String, _
                    ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Private Declare PtrSafe Function PostMessage Lib "user32" _
Alias "PostMessageA" ( _
ByVal hwnd As LongPtr, _
ByVal wMsg As LongPtr, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As LongPtr, ByVal msg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal fuFlags As LongPtr, ByVal uTimeout As LongPtr, lpdwResult As LongPtr) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" (lpsz As Any, lpiid As Any) As Long
Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Object) As LongPtr
Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr

Private Const WM_COMMAND = &H111&
Private Const WM_SYSCHAR = &H106
Private Const GW_HWNDNEXT = &H2
Private hIES  As LongPtr

Public Sub main()
  Call download_main("ダウンロード")
End Sub


Private Sub download_main(title As String)
  
  Dim ie            As Object
  Dim hDlg          As LongPtr
  Dim hWndIE        As LongPtr
  Dim h             As LongPtr
  
  Do
    Set ie = GetWindow(title)
  Loop Until Not (ie Is Nothing)
  
  h = 0
  
  Do
    DoEvents
    Sleep 1&
    h = GetDirectUI
  Loop Until h
  
  Call DownloadFileNotificationBar(h, ThisWorkbook.Path & "\test.csv")
  
  ie.DocumentElement.Document.Script.setTimeout "javascript:window.close()", 1000
    
End Sub

Private Function GetWindow(title As String) As Object
  
  Dim con       As Object
  Dim items     As Object
  Dim HtmlDoc   As Object
  Dim hwnd      As LongPtr: hwnd = 0
  Dim pid       As LongPtr: pid = 0
  Dim buf       As String * 255
  Dim ClassName As String

  Const ProcessName = "msedge.exe"
   
  Set con = CreateObject("WbemScripting.SWbemLocator").ConnectServer
  hwnd = GetTopWindow(0)
  
    
  Do
    GetClassName hwnd, buf, Len(buf)
    ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
    
    If InStr(ClassName, "Chrome_WidgetWin_") > 0 Then
      
      'ウィンドウハンドルからプロセスIDを取得し、Edgeのウィンドウかどうかを判別する
      GetWindowThreadProcessId hwnd, pid
      Set items = con.ExecQuery("Select ProcessId From Win32_Process Where (ProcessId = '" & pid & "') And (Name = '" & ProcessName & "')")
      If items.Count > 0 Then
        'Edgeの子ウィンドウ列挙
        
        EnumChildWindows hwnd, AddressOf EnumChildProcIES, 0
        If hIES <> 0 Then
          Set HtmlDoc = GetHTMLDocumentFromIES(hIES)
          If HtmlDoc Is Nothing Then
          Else
            If InStr(HtmlDoc.title, title) > 0 Then
              Set GetWindow = HtmlDoc
              Exit Do
            End If
          End If
        End If
      End If
    End If
    hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
  Loop While hwnd <> 0

End Function

Private Function EnumChildProcIES(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As LongPtr
  Dim buf As String * 255
  Dim ClassName As String
    
  GetClassName hwnd, buf, Len(buf)
  ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
  If ClassName = "Internet Explorer_Server" Then
    hIES = hwnd
    EnumChildProcIES = False
    Exit Function
  End If
  EnumChildProcIES = True
End Function

Private Function GetHTMLDocumentFromIES(ByVal hwnd As LongPtr) As Object
  Dim msg As LongPtr, res As LongPtr
  Dim iid(0 To 3) As LongPtr
  Dim ret As Object, obj As Object
  Const SMTO_ABORTIFHUNG = &H2
  Const IID_IHTMLDocument2 = "{332c4425-26cb-11d0-b483-00c04fd90119}"
   
  Set ret = Nothing '初期化
  msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
  SendMessageTimeout hwnd, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res
  If res Then
    IIDFromString StrPtr(IID_IHTMLDocument2), iid(0)
    If ObjectFromLresult(res, iid(0), 0, obj) = 0 Then Set ret = obj
  End If
  Set GetHTMLDocumentFromIES = ret
End Function

Private Function GetDirectUI() As LongPtr

  Dim con       As Object
  Dim items     As Object
  Dim HtmlDoc   As Object
  Dim hwnd      As LongPtr: hwnd = 0
  Dim pid       As LongPtr: pid = 0
  Dim buf       As String * 255
  Dim ClassName As String

  Const ProcessName = "msedge.exe"
   
  Set con = CreateObject("WbemScripting.SWbemLocator").ConnectServer
  hwnd = GetTopWindow(0)
  
    
  Do
    GetClassName hwnd, buf, Len(buf)
    ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
    
    If InStr(ClassName, "Chrome_WidgetWin_") > 0 Then
      
      'ウィンドウハンドルからプロセスIDを取得し、Edgeのウィンドウかどうかを判別する
      GetWindowThreadProcessId hwnd, pid
      Set items = con.ExecQuery("Select ProcessId From Win32_Process Where (ProcessId = '" & pid & "') And (Name = '" & ProcessName & "')")
      If items.Count > 0 Then
        'Edgeの子ウィンドウ列挙
        
        EnumChildWindows hwnd, AddressOf EnumChildProcDirectUI, 0
        
        If hIES <> 0 Then
          GetDirectUI = hIES
          Exit Do
        End If
      End If
    End If
    hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
  Loop While hwnd <> 0

End Function

Private Function EnumChildProcDirectUI(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As LongPtr
  Dim buf As String * 255
  Dim ClassName As String
    
  GetClassName hwnd, buf, Len(buf)
  ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
  If ClassName = "Frame Notification Bar" Then
    hIES = hwnd
    EnumChildProcDirectUI = False
    Exit Function
  End If
  EnumChildProcDirectUI = True
End Function

''' 通知バー/Internet Explorerダイアログを操作してファイルをダウンロード
Public Sub DownloadFileNotificationBar(ByVal hIE As Long, ByVal SaveFilePath As String)

  ''' ファイルを事前に削除
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(SaveFilePath) Then .DeleteFile SaveFilePath, True
  End With

  Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation

  ''' 通知バーの[別名で保存]を押す
  PressSaveAsMenuNotificationBar uiAuto, hIE
  ''' [名前を付けて保存]ダイアログ操作
  SaveAsFileNameDialog uiAuto, SaveFilePath
  ''' ダウンロード完了後、通知バーを閉じる
  ClosingNotificationBar uiAuto, hIE

  Set uiAuto = Nothing

End Sub

Private Function PressSaveAsMenuNotificationBar(ByRef uiAuto As CUIAutomation, ByVal ieWnd As Long)

  ''' 通知バーを取得
  Dim hwnd As Long
  Dim elmNotificationBar As IUIAutomationElement
  
  Do
    DoEvents
    Sleep 1&
    hwnd = GetDirectUI
  Loop Until hwnd

  Set elmNotificationBar = uiAuto.ElementFromHandle(ByVal hwnd)

  ''' [保存] スプリットボタン取得
  Dim elmSaveSplitButton As IUIAutomationElement
  Do
    DoEvents
    Sleep 1&
    hwnd = GetDirectUI
    Do
      DoEvents
      Sleep 1&
    Loop Until IsWindowVisible(hwnd)
    Set elmNotificationBar = uiAuto.ElementFromHandle(ByVal hwnd)
    Set elmSaveSplitButton = GetElement(uiAuto, elmNotificationBar, UIA_NamePropertyId, "保存", UIA_SplitButtonControlTypeId)
  Loop While elmSaveSplitButton Is Nothing

  ''' [保存] ドロップダウン取得
  Const ROLE_SYSTEM_BUTTONDROPDOWN = &H38&
  Dim elmSaveDropDownButton As IUIAutomationElement
  Do
    DoEvents
    Sleep 1&
    Set elmSaveDropDownButton = GetElement(uiAuto, elmNotificationBar, UIA_LegacyIAccessibleRolePropertyId, ROLE_SYSTEM_BUTTONDROPDOWN, UIA_SplitButtonControlTypeId)
  Loop While elmSaveDropDownButton Is Nothing

  '''[保存]ドロップダウン押下
  Dim iptn As IUIAutomationInvokePattern
  Set iptn = elmSaveDropDownButton.GetCurrentPattern(UIA_InvokePatternId)

  ''' メニューウインドウを取得
  Dim elmSaveMenu As IUIAutomationElement
  Do
    iptn.Invoke
    Set elmSaveMenu = GetElement(uiAuto, uiAuto.GetRootElement, UIA_ClassNamePropertyId, "#32768", UIA_MenuControlTypeId)
    DoEvents
    Sleep 1&
  Loop While elmSaveMenu Is Nothing

  ''' [名前を付けて保存(A)]ボタン押下
  Dim hWndSaveMenu As Long
  hWndSaveMenu = FindWindow("#32768", vbNullString)
  PostMessage hWndSaveMenu, &H106, vbKeyA, 0&   ' SYSCHAR=0x106

End Function

Private Function SaveAsFileNameDialog(ByRef uiAuto As CUIAutomation, ByVal SaveFilePath As String)

    '''[名前を付けて保存]ダイアログ取得
    Dim elmSaveAsWindow As IUIAutomationElement
    Do
      Set elmSaveAsWindow = GetElement(uiAuto, uiAuto.GetRootElement, UIA_NamePropertyId, "名前を付けて保存", UIA_WindowControlTypeId)
        DoEvents
        Sleep 1&
    Loop While elmSaveAsWindow Is Nothing

    '[ファイル名]欄取得 -> ファイルパス入力
    Dim elmFileNameEdit As IUIAutomationElement: Set elmFileNameEdit = GetElement(uiAuto, elmSaveAsWindow, UIA_NamePropertyId, "ファイル名:", UIA_EditControlTypeId)
    Dim vptn As IUIAutomationValuePattern: Set vptn = elmFileNameEdit.GetCurrentPattern(UIA_ValuePatternId)
    vptn.SetValue SaveFilePath

    '[保存(S)]ボタン押下
    Dim elmSaveButton As IUIAutomationElement
    Do
    Set elmSaveButton = _
      GetElement(uiAuto, elmSaveAsWindow, UIA_NamePropertyId, "保存(S)", UIA_ButtonControlTypeId)
    Loop While elmSaveButton Is Nothing

    Dim iptn As IUIAutomationInvokePattern: Set iptn = elmSaveButton.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke

End Function

Private Function ClosingNotificationBar(ByRef uiAuto As CUIAutomation, ByVal ieWnd As Long)

  ''' 通知バーを取得
  Dim hwnd As Long
  Do
    DoEvents
    Sleep 1&
    hwnd = GetDirectUI
  Loop Until hwnd

  Do
    DoEvents
    Sleep 1&
  Loop Until IsWindowVisible(hwnd)

  Dim elmNotificationBar As IUIAutomationElement: Set elmNotificationBar = uiAuto.ElementFromHandle(ByVal hwnd)


  ''' [通知バーのテキスト]取得
  Dim elmNotificationText As IUIAutomationElement
  Do
    DoEvents
    Sleep 1&
    Set elmNotificationText = GetElement(uiAuto, elmNotificationBar, UIA_NamePropertyId, "通知バーのテキスト", UIA_TextControlTypeId)
  Loop While elmNotificationText Is Nothing

  ''' [閉じる]ボタン取得
  Dim elmCloseButton As IUIAutomationElement
  Do
    DoEvents
    Sleep 1&
    Set elmCloseButton = GetElement(uiAuto, elmNotificationBar, UIA_NamePropertyId, "閉じる", UIA_ButtonControlTypeId)
  Loop While elmCloseButton Is Nothing


  ''' [閉じる]ボタン押下
  Do
    DoEvents
    Sleep 1&
  Loop Until InStr(elmNotificationText.GetCurrentPropertyValue(UIA_ValueValuePropertyId), "ダウンロードが完了しました") > 0
  Dim iptn As IUIAutomationInvokePattern: Set iptn = elmCloseButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke

End Function

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition

  Set cndFirst = uiAuto.CreatePropertyCondition(propertyId, propertyValue)
  If ctrlType <> 0 Then
      Set cndSecond = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, ctrlType)
      Set cndFirst = uiAuto.CreateAndCondition(cndFirst, cndSecond)
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function