2010-07-02 193 views

回答

30

您可以使用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:

+6

只是为将来任何人使用这个注释:您必须将ShellExecute函数放在页面顶部的声明部分。 – dmr 2010-07-02 14:42:14

+3

某些可能需要在声明语句中添加“PtrSafe”:“Private Declare PtrSafe Function ShellExecute ...”,以使其在64位中工作。 – Jroonk 2015-10-30 01:25:28

22

,你甚至可以说:

FollowHyperlink "www.google.com" 

如果你得到自动化错误然后使用http://

ThisWorkbook.FollowHyperlink("http://www.google.com") 
+7

如果在Excel中,您需要工作簿对象,例如ThisWorkbook.FollowHyperlink“www.google.com” – 2012-06-14 19:59:33

+0

我收到自动化错误。所以我需要使用'http://'。然后,完整的命令是:'ThisWorkbook.FollowHyperlink“http://www.google.com.br”' – 2015-01-08 19:04:23

+0

在Word中它是ActiveDocument.FollowHyperlink“http://www.google.com” – 2015-08-24 04:20:15

5

如果你想与ShellExecute的一个更强大的解决方案,这将打开任何文件,文件夹或网址使用默认的OS关联程序来这样做,这里是取自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:[email protected]",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()。