由于没有更好的答案，我在这里发布我的解决方案。似乎无法使用“另存为”功能而不使用SendKeys...这显然不是最优选择，因为用户可以轻松地在进程运行时主动操作他们的桌面来破坏该功能。无论如何，通过调用Download()过程来启动此过程，传递浏览器、文件名以及是否希望替换已存在的文件。如果没有传递文件名，则调用默认的“保存”功能，并将默认文件名保存在默认文件夹中。这些数据已经从StackOverflow和其他地方收集和适应，并且应该是MS Access中的一个比较有效的解决方案。
Option Explicit
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
Declare PtrSafe Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As LongPtr) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const BM_CLICK = &HF5
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Sub Download(ByRef oBrowser As InternetExplorer, _
ByRef sFilename As String, _
ByRef bReplace As Boolean)
If sFilename = "" Then
Call Save(oBrowser)
Else
Call SaveAs(oBrowser, sFilename, bReplace)
End If
End Sub
'https://dev59.com/g4Pba4cB1Zd3GeqPwLgc
Public Sub Save(ByRef oBrowser As InternetExplorer)
Dim AutomationObj As IUIAutomation
Dim WindowElement As IUIAutomationElement
Dim Button As IUIAutomationElement
Dim hWnd As LongPtr
Set AutomationObj = New CUIAutomation
hWnd = oBrowser.hWnd
hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
If hWnd = 0 Then Exit Sub
Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
Dim iCnd As IUIAutomationCondition
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
Sub SaveAs(ByRef oBrowser As InternetExplorer, _
sFilename As String, _
bReplace As Boolean)
'https://msdn.microsoft.com/en-us/library/system.windows.automation.condition.truecondition(v=vs.110).aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
Dim AllElements As IUIAutomationElementArray
Dim Element As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern
Dim iCnd As IUIAutomationCondition
Dim AutomationObj As IUIAutomation
Dim FrameElement As IUIAutomationElement
Dim bFileExists As Boolean
Dim hWnd As LongPtr
'create the automation object
Set AutomationObj = New CUIAutomation
WaitSeconds 3
'get handle from the browser
hWnd = oBrowser.hWnd
'get the handle to the Frame Notification Bar
hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
If hWnd = 0 Then Exit Sub
'obtain the element from the handle
Set FrameElement = AutomationObj.ElementFromHandle(ByVal hWnd)
'Get split buttons elements
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_SplitButtonControlTypeId)
Set AllElements = FrameElement.FindAll(TreeScope_Subtree, iCnd)
'There should be only 2 split buttons only
If AllElements.length = 2 Then
'Get the second split button which when clicked shows the other three Save, Save As, Save and Open
Set Element = AllElements.GetElement(1)
'click the second spin button to display Save, Save as, Save and open options
Set InvokePattern = Element.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
'Tab across from default Open to Save, down twice to click Save as
'Displays Save as window
SendKeys "{TAB}"
SendKeys "{DOWN}"
SendKeys "{ENTER}"
'Enter Data into the save as window
Call SaveAsFilename(sFilename)
bFileExists = SaveAsSave
If bFileExists Then
Call File_Already_Exists(bReplace)
End If
End If
End Sub
Private Sub SaveAsFilename(filename As String)
Dim hWnd As LongPtr
Dim Timeout As Date
Dim fullfilename As String
Dim AutomationObj As IUIAutomation
Dim WindowElement As IUIAutomationElement
'Find the Save As window, waiting a maximum of 10 seconds for it to appear
Timeout = Now + TimeValue("00:00:10")
Do
hWnd = FindWindow("#32770", "Save As")
DoEvents
Sleep 200
Loop Until hWnd Or Now > Timeout
If hWnd Then
SetForegroundWindow hWnd
'create the automation object
Set AutomationObj = New CUIAutomation
'obtain the element from the handle
Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
'Set the filename into the filename control only when one is provided, else use the default filename
If filename <> "" Then Call SaveAsSetFilename(filename, AutomationObj, WindowElement)
End If
End Sub
'Set the filename to the Save As Dialog
Private Sub SaveAsSetFilename(ByRef sFilename As String, ByRef AutomationObj As IUIAutomation, _
ByRef WindowElement As IUIAutomationElement)
Dim Element As IUIAutomationElement
Dim ElementArray As IUIAutomationElementArray
Dim iCnd As IUIAutomationCondition
'Set the filename control
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_AutomationIdPropertyId, "FileNameControlHost")
Set ElementArray = WindowElement.FindAll(TreeScope_Subtree, iCnd)
If ElementArray.length <> 0 Then
Set Element = ElementArray.GetElement(0)
'should check that it is enabled
'Update the element
Element.SetFocus
' Delete existing content in the control and insert new content.
SendKeys "^{HOME}" ' Move to start of control
SendKeys "^+{END}" ' Select everything
SendKeys "{DEL}" ' Delete selection
SendKeys sFilename
End If
End Sub
'Get the window text
Private Function Get_Window_Text(hWnd As LongPtr) As String
'Returns the text in the specified window
Dim Buffer As String
Dim length As Long
Dim result As Long
SetForegroundWindow hWnd
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
Buffer = Space(length + 1) '+1 for the null terminator
result = SendMessage(hWnd, WM_GETTEXT, Len(Buffer), ByVal Buffer)
Get_Window_Text = Left(Buffer, length)
End Function
'Click Save on the Save As Dialog
Private Function SaveAsSave() As Boolean
'Click the Save button in the Save As dialogue, returning True if the ' already exists'
'window appears, otherwise False
Dim hWndButton As LongPtr
Dim hWndSaveAs As LongPtr
Dim hWndConfirmSaveAs As LongPtr
Dim Timeout As Date
'Find the Save As window, waiting a maximum of 10 seconds for it to appear
Timeout = Now + TimeValue("00:00:10")
Do
hWndSaveAs = FindWindow("#32770", "Save As")
DoEvents
Sleep 200
Loop Until hWndSaveAs Or Now > Timeout
If hWndSaveAs Then
SetForegroundWindow hWndSaveAs
'Get the child Save button
hWndButton = FindWindowEx(hWndSaveAs, 0, "Button", "&Save")
End If
If hWndButton Then
'Click the Save button
Sleep 100
SetForegroundWindow hWndButton
PostMessage hWndButton, BM_CLICK, 0, 0
End If
'Set function return value depending on whether or not the ' already exists' popup window exists
Sleep 500
hWndConfirmSaveAs = FindWindow("#32770", "Confirm Save As")
If hWndConfirmSaveAs Then
SaveAsSave = True
Else
SaveAsSave = False
End If
End Function
'Addresses the case when saving the file when it already exists.
'The file can be overwritten if Replace boolean is set to True
Private Sub File_Already_Exists(Replace As Boolean)
'Click Yes or No in the ' already exists. Do you want to replace it?' window
Dim hWndSaveAs As LongPtr
Dim hWndConfirmSaveAs As LongPtr
Dim AutomationObj As IUIAutomation
Dim WindowElement As IUIAutomationElement
Dim Element As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim InvokePattern As IUIAutomationInvokePattern
hWndConfirmSaveAs = FindWindow("#32770", "Confirm Save As")
Set AutomationObj = New CUIAutomation
Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWndConfirmSaveAs)
If hWndConfirmSaveAs Then
If Replace Then
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Yes")
Else
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "No")
End If
Set Element = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
Set InvokePattern = Element.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End If
End Sub
Public Sub WaitSeconds(intSeconds As Integer)
On Error GoTo Errorh
Dim datTime As Date
datTime = DateAdd("s", intSeconds, Now)
Do
Sleep 100
DoEvents
Loop Until Now >= datTime
exitsub:
Exit Sub
Errorh:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , "WaitSeconds"
Resume exitsub
End Sub
参考文献：
SaveasDialog
True Condition
Faidootdoot
