Excel VBAでIE操作 メモ

会社でツール作成するために必要になったので備忘録として
IEのUI操作して名前を付けて保存(A)の選択とWindowsダイアログ操作の方法
(途中まで)
保存先編集がうまくいかない…

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA"_
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "User32.dll" Alias "FindWindowExA"_
(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass_
As String, ByVal lpszWindow As String) As Long
Private Declare Function SendMessage Lib "User32.dll" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Const WM_CLICK = &HF5
Private Const WM_SETTEXT = &HC
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Sub file_download_kai()
    Dim objIE As InternetExplorer
    Dim objFrame As Object
    Dim link As String
    Dim ie_dl As IUIAutomation
    Dim ie_hdl As IUIAutomationElement
    Dim nui As New CUIAutomation
    Dim dlwd As LongPtr
    Dim fn, hwnd, path As Long
    Dim wsh As Object
    Dim save_path As String

    Set wsh = CreateObject("WScript.Shell")
    save_path = wsh.specialfolders("AllUsersDesktop")
    
    'ダウンロードするファイルのリンク
    link = "*****************************************"
    
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
    objIE.navigate link
    
    '1.5秒待つ
    Sleep 1500
    
    'IEの名前を付けて保存(A)をクリック
    dlwd = FindWindowEx(0, 0, "#32770", "Internet Explorer")
    If dlwd = 0 Then Exit Sub
    Set ie_hdl = nui.ElementFromHandle(ByVal dlwd)
    
    Dim iCnd As IUIAutomationCondition
    Set iCnd = nui.CreatePropertyCondition(UIA_NamePropertyId, "名前を付けて保存(A)")
    
    Dim Button As IUIAutomationElement
    Set Button = ie_hdl.FindFirst(TreeScope_Subtree, iCnd)
    
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
    
    Sleep 500
    
    hwnd = FindWindow(vbNullString, "名前を付けて保存")
    
    '保存先編集
    path = FindWindowEx(hwnd, 0&, "WorkerW", vbNullString)
    path = FindWindowEx(path, 0&, "ReBarWindow32", vbNullString)
    path = FindWindowEx(path, 0&, "Address Band Root", vbNullString)
    path = FindWindowEx(path, 0&, "msctls_progress32", vbNullString)
    path = FindWindowEx(path, 0&, "Breadcrumb Parent", vbNullString)
    path = FindWindowEx(path, 0&, "ToolbarWindow32", vbNullString)
    Call SendMessage(path, WM_LBUTTONDOWN, 0&, vbNullString)
    Call SendMessage(path, WM_LBUTTONUP, 0&, vbNullString)
    Call SendMessage(path, WM_SETTEXT, 0&, "デスクトップ")
    
    'ファイル名編集
    fn = FindWindowEx(hwnd, 0&, "DUIViewWndClassName", vbNullString)
    fn = FindWindowEx(fn, 0&, "DirectUIHWND", vbNullString)
    fn = FindWindowEx(fn, 0&, "FloatNotifySink", vbNullString)
    fn = FindWindowEx(fn, 0&, "ComboBox", vbNullString)
    fn = FindWindowEx(fn, 0&, "Edit", vbNullString)
    Call SendMessage(fn, WM_SETTEXT, 0&, "test.xlms")      
End Sub