VBA excel to automate IE9 to click Save As without using send keys

时间:2018-02-03 10:12:35

标签: excel vba internet-explorer automation

i have been using the code below to download file from internet explorer and have configured in windows task scheduler. When the system is locked the send keys will not help ie to choose Save As. Is there any alternate way to click on save as from IE?

Sub SaveAs(ByRef oBrowser As InternetExplorer, _
                 sFilename As String, _
                 sFolder As String, _
                 bReplace As Boolean)

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
'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}"
    Application.Wait Now + #12:00:01 AM#
    SendKeys "{DOWN}"
    Application.Wait Now + #12:00:01 AM#
    SendKeys "{ENTER}"
    'Enter Data into the save as window


    Call saveAsFilename(sFolder, sFilename)
    bFileExists = SaveAsSave
    If bFileExists Then
        Application.Wait Now + #12:00:01 AM#
        Call File_Already_Exists(bReplace)
    End If
End If

0 个答案:

没有答案