Открыть HTML-страницу в браузере по умолчанию с VBA? - PullRequest
29 голосов
/ 02 июля 2010

Как открыть страницу HTML в браузере по умолчанию с VBA?Я знаю, это что-то вроде:

Shell "http://myHtmlPage.com"

Но я думаю, что я должен ссылаться на программу, которая откроет страницу.

Ответы [ 4 ]

38 голосов
/ 02 июля 2010

Вы можете использовать функцию Windows API ShellExecute для этого:

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

Public Sub OpenUrl()

    Dim lSuccess As Long
    lSuccess = ShellExecute(0, "Open", "www.google.com")

End Sub

Просто короткое замечание относительно безопасности: если URL-адрес поступает от пользовательского ввода, убедитесь, что этот вход строго проверен, поскольку ShellExecute будет выполнять любую команду с разрешениями пользователя, также будет выполняться format c:, если пользователь является пользователем. администратор.

32 голосов
/ 14 июня 2012

Вы можете даже сказать:

FollowHyperlink "www.google.com"

Если вы получили ошибку автоматизации, используйте http://:

ThisWorkbook.FollowHyperlink("http://www.google.com")
5 голосов
/ 04 декабря 2012

Если вам нужно более надежное решение с ShellExecute, которое откроет ЛЮБОЙ файл, папку или URL-адрес, используя для этого программу, связанную с ОС по умолчанию, вот функция, взятая из http://access.mvps.org/access/api/api0018.htm:

'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:\TEMP\",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)

    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********

Простопоместите это в отдельный модуль и вызовите fHandleFile () с правильными параметрами.

3 голосов
/ 02 июля 2010
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...