2010-07-02 23 views

Respuesta

30

Puede utilizar la función API de Windows ShellExecute para hacerlo:

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 

Sólo una breve observación relativa a la seguridad: Si la URL proviene de la entrada del usuario asegurarse de validar estrictamente esa entrada como ShellExecute podría ejecutar cualquier comando con los permisos del usuario, también se ejecutará un format c: si el usuario es un administrador.

+6

Sólo una nota para cualquier persona que podría utilizar esto en el futuro: Tienes que poner la función ShellExecute en la parte superior de la página, en la sección de declaraciones. – dmr

+3

Algunos pueden necesitar agregar "PtrSafe" en la instrucción declare: "Private Declare PtrSafe función ShellExecute ..." para que funcione en 64 bits. Si – Jroonk

22

Puede incluso decir:

FollowHyperlink "www.google.com" 

Si aparece Error de automatización a continuación, utilizar http://:

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

en Excel, se necesita un objeto de libro, como ThisWorkbook.FollowHyperlink "www.google.com" –

+0

que estaba recibiendo Error de automatización. Entonces necesité usar 'http: //'. A continuación, el comando completo es: 'ThisWorkbook.FollowHyperlink "http://www.google.com.br"' –

+0

En Word es ActiveDocument.FollowHyperlink "http://www.google.com" –

5

Si desea una solución más robusta con ShellExecute que abrir cualquier archivo, carpeta o URL utilizando el programa asociado al sistema operativo predeterminado para hacerlo, aquí hay una función tomada de 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 ********** 

Simplemente ponga esto en un módulo separado y llame a fHandleFile() con los parámetros correctos.

Cuestiones relacionadas