VBA 从 Internet Explorer 转换到 Edge 或 chrome 浏览器的脚本

Question

我正在寻找以下代码以将 Internet Explorer 转换为 Edge 浏览器，请您帮忙排序。

Sub CHECK_STATUS()
 
    Dim cell As Range
    Dim IntExp As Object
    
    Set IntExp = CreateObject("InternetExplorer.Application")
    IntExp.Visible = False
 
    For Each cell In Range("A2:A20000")
        'Here A2 is cell Address where we have stored urls which we need to test.
        
        If Left(cell.Value, 4) = "http" Then
            
            ' Goto web page
            IntExp.navigate cell.Text
            
           ' Below loop will run until page is fully loaded
            Do While IntExp.Busy Or IntExp.readyState <> 4
                DoEvents
            Loop
 
            ' Now use text which you want to search , error text which you want to compare etc.
            Dim ieDoc As Object
            Set ieDoc = IntExp.document
            
            If ieDoc.getElementsByClassName("box-content").Length <> 0 Then
                cell.Offset(, 1).Value = ieDoc.getElementsByClassName("box-content")(0).innerText 
            End If
        End If
    Next cell
 
    IntExp.Quit
    Set IntExp = Nothing
End Sub

Answer 1

您需要使用 SeleniumBasic 来自动化 VBA 中的 Edge。 SeleniumBasic 是一个基于 Selenium 的浏览器自动化框架，适用于 VB.Net、VBA 和 VBScript。

我同意 QHarr 的意见，您也可以按照以下步骤使用 SeleniumBasic 自动化 Edge 浏览器：

从this link下载最新版本的SeleniumBasic v2.0.9.0并安装。
从this link下载对应版本的Edge WebDriver。
找到SeleniumBasic在我电脑里的路径C:\Users\%username%\AppData\Local\SeleniumBasic（可能也在这个路径C:\Program Files\SeleniumBasic），复制Edge WebDrivermsedgedriver.exe到这个路径
将 msedgedriver.exe 重命名为 edgedriver.exe。
打开Excel并编写VBA代码。
在VBA代码界面，点击Tools > References，添加Selenium Type Library reference，点击确定保存。
我写了一个简单的 VBA 代码来展示如何使用 SeleniumBasic 自动化 Edge。大家可以参考一下，根据自己的需求修改代码：

Public Sub Selenium()
    For Each cell In Range("A2:A20000")
        Dim bot As New WebDriver
        If Left(cell.Value, 4) = "http" Then
            bot.Start "edge", cell.Value
            bot.Get "/"
            If Not bot.FindElementsByClass("box-content") Is Nothing Then
                cell.Offset(, 1).Value = bot.FindElementsByClass("box-content")(1).Text
            End If
        End If
        bot.Wait 3000
        bot.Quit
    Next cell
End Sub

Answer 2

我在银行的工作中一直使用 IE 和 Internet 对象模型 (IOM) 来实现内部 web-based 系统的自动化。自从 2022 年 6 月 15 日微软宣布不再支持 IE 后，我开始在互联网上寻找可能的替代解决方案。经过调查，我发现在Edge浏览器上实现自动化有两种解决方案：1）SeleniumBasic或2）Win API。虽然 SelenimBasic 似乎是论坛上的主流建议，但 Win API 在几个不同方面都可以被视为更好的解决方案，特别是对于我自己的情况。

Win 的优点API 解决方案：

无需安装和定期更新 Edge 驱动程序。
能够使用多个现有的 Edge 浏览器windows（在程序启动前已打开）进行自动化。
现有IOM解决方案中的大部分代码都可以保留并且re-applied。这是因为IOM和WinAPI的解决方案最终都应该使用HTML文档对象模型（DOM）来实现网页自动化。区别在于查找浏览器和从浏览器获取HTML文档的方式。

Win 的缺点 API 解决方案：

我们可以在 Edge 浏览器上对“网页”进行自动化，但不能对“Edge 浏览器”本身进行自动化。它不像 IOM 和 SeleniumBasic 那样可以控制 Web 浏览器。为此，我使用Shell函数和DOS命令来实现自动打开和关闭Edge浏览器。
网页必须在Edge浏览器中以IE模式打开，这意味着该方案以微软未来对Edge浏览器IE模式的方向为准。

分享我在 Edge 浏览器网页自动化上使用 Win API 的经验：

将以下代码放入一个新的空白模块中。我通常将此模块命名为“MsEdge”。该模块中的代码无需修改即可使用。对Win不太了解也可以直接使用代码API.

Public lngProcessID_Close As Long

'Part 1 --- Locate IES

Private strHwndIES As String

Private lngHwndIndex As Long

Private Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Declare Function EnumChildWindows Lib "user32" ( _
    ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

'Part 2 --- Get HTMLDocument from IES

Private Const SMTO_ABORTIFHUNG = &H2

Private Const GUID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"

Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" ( _
    ByVal lpString As String) As Long

Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" ( _
    ByVal hWnd As Long, _
    ByVal msg As Long, _
    ByVal wParam As Long, _
    lParam As Any, _
    ByVal fuFlags As Long, _
    ByVal uTimeout As Long, _
    lpdwResult As Long) As Long

Private Declare Function IIDFromString Lib "ole32" ( _
    lpsz As Any, lpiid As Any) As Long

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
    ByVal lResult As Long, _
    riid As Any, _
    ByVal wParam As Long, _
    ppvObject As Any) As Long

'Part 3 --- Check Process Name

Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
    ByVal hWnd As Long, lpdwProcessId As Long) As Long


Public Function findEdgeDOM(Title As String, URL As String) As Object

    'Find criteria-hitting Edge page in IE mode

    Dim hwndIES As Long

    Do

        hwndIES = enumHwndIES

        If hwndIES Then

            Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)

            If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then

                Do

                    hwndIES = enumHwndIES

                Loop While hwndIES

                Exit Function

            Else

                Set findEdgeDOM = Nothing

            End If

        End If

    Loop While hwndIES

End Function

Public Function enumHwndIES() As Long

    'Get all hwnds of IES

    If Len(strHwndIES) = 0 Then

        EnumWindows AddressOf EnumWindowsProc, 0

        lngHwndIndex = 0

    End If

    'Exit function when overflow

    If lngHwndIndex + 1 > (Len(strHwndIES) - Len(Replace(strHwndIES, ",", ""))) Then

        enumHwndIES = 0

        strHwndIES = ""

        Exit Function

    End If

    'Return IES hwnd one by one

    enumHwndIES = CLng(Split(Left(strHwndIES, Len(strHwndIES) - 1), ",")(lngHwndIndex))

    lngHwndIndex = lngHwndIndex + 1

End Function

Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean

    Dim lngProcessID As Long

    GetWindowThreadProcessId hWnd, lngProcessID

    EnumChildWindows hWnd, AddressOf EnumChildProc, lngProcessID

    EnumWindowsProc = True

End Function

Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean

    Dim strTargetClass As String, strClassName As String

    strTargetClass = "Internet Explorer_Server"

    strClassName = getClass(hWnd)

    If strClassName = strTargetClass Then

        If GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process WHERE ProcessId='" & lParam & "' AND Name='msedge.exe'").Count Then

            strHwndIES = strHwndIES & hWnd & ","

            lngProcessID_Close = lParam

            EnumChildProc = False

            Exit Function

        End If

    End If

    EnumChildProc = True

End Function

Private Function getClass(hWnd As Long) As String

    Dim strClassName As String

    Dim lngRetLen As Long


    strClassName = Space(255)

    lngRetLen = GetClassName(hWnd, strClassName, Len(strClassName))

    getClass = Left(strClassName, lngRetLen)

End Function

Public Function getHTMLDocumentFromIES(ByVal hWnd As Long) As Object

    Dim iid(0 To 3) As Long

    Dim lMsg As Long, lRes As Long

    lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")

    SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes

    If lRes Then

        IIDFromString StrPtr(GUID_IHTMLDocument2), iid(0)

        ObjectFromLresult lRes, iid(0), 0, getHTMLDocumentFromIES

    End If

End Function

Public Sub closeEdge(Title As String, URL As String)

    'Close a Edge browser (the last one in EnumWindows order) with criteria-hitting webpage

    lngProcessID_Close = 0

    Dim findEdgeDOM As Object

    Dim hwndIES As Long

    Do

        hwndIES = enumHwndIES

        If hwndIES Then

            Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)

            If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then

                Shell "TaskKill /pid " & lngProcessID_Close

                Do

                    hwndIES = enumHwndIES

                Loop While hwndIES

                Exit Sub

            End If

        End If

    Loop While hwndIES

End Sub

应用“MsEdge”模块中的功能。有几个应用示例供您参考。建议在另一个模块放置和测试以下代码：

Sub findEdgeDOM_DemoProc()

    'Demo Proc : Use findEdgeDOM Function to get DOM of specific Edge webpage by Title AND URL

    'Dim docHTML As MSHTML.HTMLDocument     '--- Early Binding

    Dim docHTML As Object                   '--- Late Binding

    Set docHTML = findEdgeDOM("Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here")
    ‘You can fill just one argument with either part of webpage title or URL as keyword to search for the target browser and leave another one blank (“”). If you provide both title and URL, the funcitons return DOM of the only browser that meets both criteria.

    If Not docHTML Is Nothing Then Debug.Print docHTML.Title, docHTML.URL

End Sub

Sub goEdge()

    'Go through every Edge webpage (opened in IE mode) and print out hwndIES, webpage Title & webpage URL

    Dim hwndIES As Long

    'Dim docHTML As MSHTML.HTMLDocument     '--- Early Binding

    Dim docHTML As Object                   '--- Late Binding

    Do

        hwndIES = enumHwndIES

        If hwndIES Then

            Set docHTML = getHTMLDocumentFromIES(hwndIES)

            Debug.Print hwndIES, docHTML.Title, docHTML.URL

        Else

            Debug.Print "Procedure End"

        End If

    Loop While hwndIES

End Sub

Sub openEdgeByURL_DemoProc()

    'Open Edge browser to specific URL

    openEdgeByURL "Input Webpage URL Here"

End Sub

Public Sub openEdgeByURL(URL As String)

    'Please change the path to your msedge.exe location in your PC

    Shell "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe -url " & URL, vbNormalFocus

End Sub

Sub closeEdge_DemoProc()

    'Close Edge browser

    closeEdge "Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here"

End Sub

VBA 从 Internet Explorer 转换到 Edge 或 chrome 浏览器的脚本

VBA Script to convert from internet explorer to Edge or chrome browser

excel

selenium

vba

microsoft-edge