Summary
名前を付けて保存ができない場合がある
結論
SaveAsのところはpostmessageで
他はui automationでやるといいかも
ポイント
''' [名前を付けて保存(A)]ボタン押下
Dim hWndSaveMenu As Long
hWndSaveMenu = FindWindow("#32768", vbNullString)
PostMessage hWndSaveMenu, &H106, vbKeyA, 0& ' SYSCHAR=0x106
リスペクト
Respect : @kinuasa https://www.ka-net.org/blog/?p=4855
コード
#If VBA7 Then
Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
''' 通知バー/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
Do
DoEvents
koffeetime.Wait 1&
hwnd = FindWindowEx(ieWnd, 0, "Frame Notification Bar", vbNullString)
Loop Until hwnd
Do
DoEvents
koffeetime.Wait 1&
Loop Until IsWindowVisible(hwnd)
Dim elmNotificationBar As IUIAutomationElement: Set elmNotificationBar = uiAuto.ElementFromHandle(ByVal hwnd)
''' [保存] スプリットボタン取得
Dim elmSaveSplitButton As IUIAutomationElement
Do
DoEvents
koffeetime.Wait 1&
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
koffeetime.Wait 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
koffeetime.Wait 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
koffeetime.Wait 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
koffeetime.Wait 1&
hwnd = FindWindowEx(ieWnd, 0, "Frame Notification Bar", vbNullString)
Loop Until hwnd
Do
DoEvents
koffeetime.Wait 1&
Loop Until IsWindowVisible(hwnd)
Dim elmNotificationBar As IUIAutomationElement: Set elmNotificationBar = uiAuto.ElementFromHandle(ByVal hwnd)
''' [通知バーのテキスト]取得
Dim elmNotificationText As IUIAutomationElement
Do
DoEvents
koffeetime.Wait 1&
Set elmNotificationText = GetElement(uiAuto, elmNotificationBar, UIA_NamePropertyId, "通知バーのテキスト", UIA_TextControlTypeId)
Loop While elmNotificationText Is Nothing
''' [閉じる]ボタン取得
Dim elmCloseButton As IUIAutomationElement
Do
DoEvents
koffeetime.Wait 1&
Set elmCloseButton = GetElement(uiAuto, elmNotificationBar, UIA_NamePropertyId, "閉じる", UIA_ButtonControlTypeId)
Loop While elmCloseButton Is Nothing
''' [閉じる]ボタン押下
Do
DoEvents
koffeetime.Wait 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
現場からは以上です