VBA, WebBrowser. Открывать ссылки в стандратном браузере системы

Рейтинг: 0Ответов: 1Опубликовано: 01.06.2023

Имеется MS Access и формуляр с элементом управления WebBrowser. WebBrowser отображает страницу, которая содежит ссылки с атрибутом открытия в новом окне (target="_blank"). При клике на эти ссылки открывается старый Internet Explorer и страница выглядит ужасно, так как браузер устаревший и многого не поддерживает. Как сделать так, что бы при кликах по ссылкам открывался стандартный браузер системы?

Замечу, что элемент управления уже эмулирует Edge (FEATURE_BROWSER_EMULATION/msaccess.exe=99999), но ссылки все равно открываются в Internet Explorer.

vba браузер internet-explorer access
Источник: Stack Overflow на русском

Ответы

▲ 0

Я нашел одно рабочее решение сам и хочу поделиться им с вами. В проект добавил ссылку на "Microsoft HTML Object Library" (mshtml.tlb). Код достаточно ясный

Option Compare Database
Option Explicit

Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Dim WithEvents myWB As WebBrowser_V1 ' alternate interface exposing additional events

Private Sub Befehl1_Click()
    myWB.Navigate "https://my_website.com"
End Sub

Private Sub Form_Load()
    Set myWB = WebBrowser0.Object ' Ok, point myWB to alternaticve interface of WebBrowser1
      
End Sub

Private Sub myWB_NewWindow(ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String, Processed As Boolean)
    
    Dim startsWith As Boolean
    startsWith = LCase$(Left(URL, 8)) = "https://" Or LCase$(Left(URL, 7)) = "http://"
    
    If startsWith Then
        OpenURL (URL)
        Processed = True
    End If
    
End Sub

Sub OpenURL(URL As String)
    ' Open URL in the default web browser
    Dim lSuccess As Long
    lSuccess = ShellExecute(0, "Open", URL)
End Sub