Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

https://www.automateexcel.com/vba/automate-internet-explorer-ie-using/

https://stackoverflow.com/questions/62782892/bring-internet-explorer-download-window-to-focus-foreground-via-vba/62883797#62883797

https://stackoverflow.com/questions/41367209/how-can-i-maximize-an-ie-window-created-by-vba-with-shdocvw-internetexplorer-com

https://stackoverflow.com/a/39207730/5079799

Functions:

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function CloseClipboard Lib "user32" () As Long
      Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
      Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
      Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
      Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
      Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
      Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If

Public Const BM_CLICK = &HF5
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE  

Public IEObj As Object, HWNDSrc As LongPtr
 
Public Sub OpenIEURL(URL As String, Optional ShowIEWindow As Boolean, Optional SecondURL As String)
 Application.Wait (Now() + TimeValue("00:00:01"))
 Set IEObj = CreateObject("InternetExplorer.Application")
    
 IEObj.navigate URL
 Do Until IEObj.readyState = 4
  DoEvents
 Loop
 If ShowIEWindow = True Then
  IEObj.Visible = True
  IEObj.TheaterMode = True
 End If
 
 If SecondURL <> "" Then
  IEObj.navigate SecondURL
 End If
 
 'Bring IEObj to Focus
 HWNDSrc = IEObj.hWnd
 'Debug.Print HWNDSrc
 
 If ShowIEWindow = True Then
  SetForegroundWindow HWNDSrc
  IEObj.Visible = False
  IEObj.Visible = True
  Call Activate_A_Window(URL)
 End If
End Sub
Public Sub Activate_A_Window(WindowName As String)
    Dim IE As Object
    Dim Windows As Object: Set Windows = CreateObject("Shell.Application").Windows
    Dim Window As Object
    Dim my_title As String

    For Each Window In Windows
        my_title = Window.LocationName
        Debug.Print "Window Title = " & my_title
        If InStr(1, my_title, WindowName) Then
            Set IE = Window
            Exit For
        End If
    Next Window

    If Not IE Is Nothing Then 'Make sure IE was found as a window
        If CBool(IsIconic(IE.hWnd)) Then ' If it's minimized, show it
            ShowWindow IE.hWnd, SW_RESTORE
        End If

        SetForegroundWindow IE.hWnd 'Set the window as the foreground
    Else
        Debug.Print (WindowName & " could not be located")
    End If

End Sub
Public Sub File_Download_Click_Save(HWNDSrc As LongPtr)
'find and click save as button
 Dim o As IUIAutomation
 Dim h As LongPtr
 Set o = New CUIAutomation
 h = HWNDSrc
 IEObj.Visible = True
 Dim e As IUIAutomationElement
 Dim iCnd As IUIAutomationCondition
 Dim Button As IUIAutomationElement
 Set e = o.ElementFromHandle(ByVal h)
 Set Button = Nothing
 Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
 Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
 Dim InvokePattern As IUIAutomationInvokePattern
 Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
 InvokePattern.Invoke
 IEObj.Visible = False
End Sub
Public Sub CloseIEObj()
 'Unload IE
 IEObj.TheaterMode = False
 Application.Wait (Now() + TimeValue("00:00:04"))
 IEObj.Quit
 Set IEObj = Nothing
 Application.Wait (Now() + TimeValue("00:00:01"))
End Sub



Module:

Sub Test()
 Dim URL As String
 URL = "http://google.com"  
 Call OpenIEURL(URL, False)    

'..Do Stuff

 HWNDSrc = IEObj.hWnd
 Debug.Print "HWNDSrc = " & HWNDSrc
 Application.Wait (Now() + TimeValue("00:00:4"))
 Call File_Download_Click_Save(HWNDSrc)

 Call CloseIEObj
End SUb
  • No labels