How to Close Microsoft Edge Webpage(s) Using VBA

2

2ramsays

New Member
Joined
Nov 27, 2022
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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
 
Sort by date Sort by votes

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
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:
VBA Code: 
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 :
VBA Code: 
Sub Exmaple1()
    'Close all tabs whose captions contain the string "MrExcel"
    CloseEdgedTabs PartialTabCaption:="MrExcel"
End Sub

VBA Code: 
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.
 
Last edited:
Upvote 1
Solution
Jaafar Tribak said:
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:
VBA Code: 
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 :
VBA Code: 
Sub Exmaple1()
    'Close all tabs whose captions contain the string "MrExcel"
    CloseEdgedTabs PartialTabCaption:="MrExcel"
End Sub

VBA Code: 
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.
Click to expand...
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
 
Upvote 0
2ramsays said:
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
Click to expand...
Glad you got it working in the end and thanks for the feedback (y)
 
  • Like
Reactions: Zot
Upvote 1
I tried above solution and got the following:

- Windows 10 (Home) 64-bit, Edge 110.0.1587.50 - Doesn't close tabs or do anything...at least it didn't crash! 🤔
- Windows 8.1 64-bit, Edge 109.0.1518.78 - Works well, tabs w/key words closed. 🙂
- Windows 7 (Premium SP1) 64-bit, (networked), Edge 109.0.1518.78 - Crashes, w/Run-time error '91' @ line: i& = 1& To AccSystemPane.accChildCount. 😮

Any way to make this coding more robust?
 
Upvote 0
VBA Code: 
Sub CloseChromeTabs(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&, 1&, 0&, 0&, 0&, 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)
                            'only the visible active tab as a single Real Accessible Object child Close[push button - Visible]
                            'other tabs are not Container, they are Real Accessible Object, no child, and for them default action is activate
                            AccTab.accDoDefaultAction (AccTab.accChildCount)
                        End If
                    Next i
                End If
            End If
        End If
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    Loop
 
End Sub

Hello
This fixes the path to navigate in the hierarchy in the up-to-date version of Chrome (Version 116.0.5845.187 (Official Build) (64-bit))
Default action must be called twice: once to activate the tab, then is get populated with a child named "Close" of role push button, then call the default action of this child.
I am now using Excel 64-bit
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
How to login with username and password via Microsoft Edge in VBA code
Replies
1
Views
315
healeydm
H
L
  • Question
How to Save File from Webpage using VBA
Replies
1
Views
1K
Anthony47
A
B
  • Solved
Intersect Method using a variable range
Replies
2
Views
68
benzids
B
S
  • Solved
VBA to find string, search previous, return result in single column of data
2
Replies
11
Views
613
Peter_SSs
Peter_SSs
6StringJazzer
  • Question
Constantly getting "Out of memory" messages when VBA window is open
Replies
7
Views
244
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,215,365
Messages
6,124,513
Members
449,168
Latest member
CheerfulWalker

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top