How to Close Microsoft Edge Webpage(s) Using VBA

[2ramsays]

I tried searching for a solution but could not locate anything to help. As the subject describes, I would like to run a macro to close specific webpages when I am finished with them while leaving one or more others open. Depending on the webpage, I either download an Excel file from it (if available) or copy and paste information into an existing worksheet. Once I have done that I would like the webpage to close, I assume running a macro to do this would work but I cannot figure out how to do this. I don't have any code to share as I don't know where to begin.

I am using Microsoft 365 with Microsoft Edge Version 107.0.1418.56 (Official build) (64-bit).

Thanks,

Dave

 

[Jaafar Tribak]

Hi, see how this goes.

The CloseEdgedTabs routine takes in its argument a string contained in the caption of the tab(s) that you want to be closed. In othere words,the routine performs a partial search.

So, for example, if you pass the string "Youtube" to the CloseEdgedTabs routine, all the tabs opened in the Edge browser(s) that contain the string\word "Youtube" as part of their caption, will be closed... The string is not case sensitive.


Place this code in a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If
 
#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
#End If


Sub CloseEdgedTabs(ByVal PartialTabCaption As String)

    Const SC_RESTORE = &HF120&
    Const WM_SYSCOMMAND As Long = &H112
    Const SC_MAXIMIZE As Long = &HF030&
    Const GW_HWNDNEXT = 2&
 

    Dim AccWidgetWin As IAccessible, AccSystemPane As IAccessible, AccTab As IAccessible
    Dim vTemp As Variant
    Dim sClassName As String * 256&, lRet As Long, i As Long
    Dim hwnd As LongPtr
 
    hwnd = GetTopWindow(NULL_PTR)
    Do While hwnd <> NULL_PTR
        lRet = GetClassName(hwnd, sClassName, 256&)
        If Left(sClassName, lRet) = "Chrome_WidgetWin_1" Then
            If hwnd Then
                Set AccWidgetWin = HwndToAcc((hwnd))
                Set vTemp = AccWidgetWin
                For i = 1& To 7&
                    If TypeName(vTemp) <> "Empty" Then
                        Call AccessibleChildren(vTemp, Choose(i&, 0&, 0&, 3&, 0&, 0&, 1&, 0&), 1&, vTemp, 1&)
                    End If
                Next i&
                If TypeName(vTemp) <> "Empty" Then
                    Set AccSystemPane = vTemp
                    For i& = 1& To AccSystemPane.accChildCount
                        If InStr(1, AccSystemPane.accName(i&), PartialTabCaption, vbTextCompare) Then
                            DoEvents
                            If IsIconic(hwnd) Then
                                Call SendMessage(hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, ByVal NULL_PTR)
                            End If
                            Set AccTab = AccSystemPane.AccChild(i&)
                            AccTab.accDoDefaultAction (AccTab.accChildCount)
                        End If
                    Next i
                End If
            End If
        End If
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    Loop
 
End Sub

Private Function HwndToAcc(ByVal hwnd As LongPtr) As IAccessible

    Const ID_ACCESSIBLE As String = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
 
    Dim tGUID(0& To 3&) As Long
    Dim oIAc As IAccessible
 
    If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0&))) = S_OK Then
        If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oIAc) = S_OK Then
           Set HwndToAcc = oIAc
        End If
    End If

End Function

Code Usage :

Sub Exmaple1()
    'Close all tabs whose captions contain the string "MrExcel"
    CloseEdgedTabs PartialTabCaption:="MrExcel"
End Sub

Sub Exmaple2()
    'Close all tabs whose captions contain the string "Youtube"
    CloseEdgedTabs PartialTabCaption:="Youtube"
End Sub

I have tested this on different pages and it worked ok. I hope it works for you too.

 

[Jaafar Tribak]

Thank you very much for all the work and testing you put into this, it is appreciated. It works perfectly for me. Have a wonderful day.

Dave

Glad you got it working in the end and thanks for the feedback

 

[Zot]

See if this helps

ページのタイトルを指定してEdgeのタブを閉じるVBAマクロ 関連Q&A：https://docs.microsoft.com/en-us/answers/questions/566091/how-to-close-microsoft-edge-browser-coding-by-exce.html

ページのタイトルを指定してEdgeのタブを閉じるVBAマクロ 関連Q&A：https://docs.microsoft.com/en-us/answers/questions/566091/how-to-close-microsoft-edge-browser-coding-by-exce.html - ページのタイトルを指定してEdgeのタブを閉じるマクロ.vb

gist.github.com

It a link from this page

how to close microsoft edge browser coding by excel vba - Microsoft Q&A

Microsoft Q&A is the best place to get answers to all your technical questions on Microsoft products and services. Community. Forum.

learn.microsoft.com

 

[2ramsays]

Thank you Zot for pointing me in that direction. I copied and pasted the code into a module and I receive a compile error on Dim uiAuto As CUIAutomation.
I am a novice when it comes to VBA so you are aware of my abilities.

Thanks,

Dave

Sub test()

Dim BrWsr As Variant

Dim uiAuto As CUIAutomation
Set uiAuto = New CUIAutomation

Dim elmRoot As IUIAutomationElement
Set elmRoot = uiAuto.GetRootElement

Dim cndChromeWidgetWindows As IUIAutomationCondition
Set cndChromeWidgetWindows = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "Chrome_WidgetWin_1")
Dim aryChromeWidgetWindows As IUIAutomationElementArray
Set aryChromeWidgetWindows = elmRoot.FindAll(TreeScope_Children, cndChromeWidgetWindows)

Dim wptn As IUIAutomationWindowPattern, i As Integer

Set BrWsr = CreateObject("Shell.Application")

TEST_site = "Yahoo! JAPAN"

Url = "microsoft-edge:" & TEST_site

BrWsr.ShellExecute Url

For i = 0 To aryChromeWidgetWindows.Length - 1
If aryChromeWidgetWindows.GetElement(i).CurrentName Like "*- Microsoft" & ChrW(&H200B) & " Edge" Then
Set wptn = aryChromeWidgetWindows.GetElement(i).GetCurrentPattern(UIA_WindowPatternId)
wptn.Close
End If
Next

End Sub

 

[Zot]

I was more like just helping you Google

Hope someone out there can give further help. I have yet to study this code

 

[Jaafar Tribak]

That code requires that you set a reference to the UIAutomationClient library via Tools\References in the VBE.

 

[2ramsays]

Thank you Jaafar, that allowed the macro to run. However, this closed the entire Edge Browser instead of only closing the one webpage referenced. The first reply from Zot was very helpful but based on the comments on the site provided, this has not been solved. Does anyone know how to one webpage while leaving Edge open with other tabs?

Dave

 

[Jaafar Tribak]

Thank you Jaafar, that allowed the macro to run. However, this closed the entire Edge Browser instead of only closing the one webpage referenced. The first reply from Zot was very helpful but based on the comments on the site provided, this has not been solved. Does anyone know how to one webpage while leaving Edge open with other tabs?

Dave

Same here. I couldn't successfully close specific tabs with those codes.
Have you considered using the MSAA instead of using IUIAutomation ?

 

[2ramsays]

I am a novice or maybe a beginner and I don't know what MSAA is. After using the macro that closes the entire browser I ran it a second time and the macro opened the browser again with my normal tabs plus Google which is part of the code so for now this accomplishes what I wanted to do other than the extra Google tab. I will continue to search for a solution just to see if it can be done. If I find one somewhere I will post here again for others to reference.

Thanks for everyone's help here.

Dave