VBA – Apertura de archivos y URL

Entonces, ¿qué hace un desarrollador cuando no puede dormir? ¡Explora qué opciones se pueden usar para abrir archivos y/o URL, por supuesto!

En este artículo intentaré explorar múltiples evaluaciones que se pueden usar para abrir Archivos y URLS ¡Usando VBA, la elección de la que se puede usar le queda decidir! Dicho esto, me expandiré:

• Acceso ‘Método de seguimiento de la luz
• API de FileProTocolhandler
• API ShellexCute
• Objeto de shell

Acceso ‘Método de seguimiento de la luz

En el acceso, la técnica más fácil de abrir un archivo o navegar a una URL es simplemente usar el método de aplicación.

En una línea de código simple, como se muestra a continuación, puede abrir cualquier archivo o URL en la aplicación asociada predeterminada del usuario.

'OpenURL1 "
'OpenURL1 "C:\Users\Microsoft\Documents\Test.pdf" -> launches in system default app
'OpenURL1 "C:\Users\Microsoft\Documents\Image.jpg" -> launches in system default app
Function OpenURL1(ByVal sURL As String)
    Application.FollowHyperlink sURL
End Function

El único problema es que dependiendo del estado de ánimo de Microsoft, la configuración del registro, … algunos usuarios recibirán la siguiente advertencia que puede ser alarmante para algunos:

Los hipervínculos pueden ser perjudiciales para su computadora y datos. Para proteger su computadora, haga clic solo en esos hipervínculos de fuentes de confianza. ¿Quieres continuar?

Ahora hay formas de desactivar tales mensajes, pero usted entra en piratear el registro y no todos tienen los permisos necesarios … debería desear explorar esto más, no dude en mirar:

• Habilitar o deshabilitar los mensajes de advertencia de hipervínculo en los programas de oficina de 2007 y en los programas de la oficina 2010
• Deshabilitar el mensaje «Hyperlinks puede ser perjudicial para su computadora y datos» en Office 2016

Dicho esto, para mí, esto me llevó a comenzar a explorar qué otras opciones existían y de eso se originó el resto de este artículo.

API de FileProTocolhandler

Otra opción es usar la API FileProTocolhandler.

Public Declare Function FileProtocolHandler Lib "url.dll" _
                                            Alias "FileProtocolHandlerA" ( _
                                            ByVal hwnd As Long, _
                                            ByVal hinst As Long, _
                                            ByVal lpszCmdLine As String, _
                                            ByVal nShowCmd As Long _
                                            ) As Long

'OpenURL2 "
'OpenURL2 "C:\Users\Microsoft\Documents\Test.pdf" -> launches in system default app
'OpenURL2 "C:\Users\Microsoft\Documents\Image.jpg" -> launches in system default app
Public Sub OpenURL2(ByVal sURL As String)
    FileProtocolHandler 0, 0, sURL, 1
End Sub

API ShellexCute

Otra opción es usar la API de ShellexCute. He suministrado todas las constantes de acuerdo con la documentación disponible, pero obviamente no necesita llevarlas todas si no planea usarlas. Todo eso para decir, el código puede ser algo simplificado.

'
Public Declare Function ShellExecute 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
'ShellExecute nShowCmd values
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
'ShellExecute Return Codes
'0 'The operating system is out of memory or resources.
Private Const ERROR_FILE_NOT_FOUND = 2    'The specified file was not found.
Private Const ERROR_PATH_NOT_FOUND = 3    'The specified path was not found.
Private Const ERROR_BAD_FORMAT = 11    'The .exe file is invalid (non-Win32 .exe or error in .exe image).
Private Const SE_ERR_ACCESSDENIED = 5    'The operating system denied access to the specified file.
Private Const SE_ERR_ASSOCINCOMPLETE = 27    'The file name association is incomplete or invalid.
Private Const SE_ERR_DDEBUSY = 30    'The DDE transaction could not be completed because other DDE transactions were being processed.
Private Const SE_ERR_DDEFAIL = 29    'The DDE transaction failed.
Private Const SE_ERR_DDETIMEOUT = 28    'The DDE transaction could not be completed because the request timed out.
Private Const SE_ERR_DLLNOTFOUND = 32    'The specified DLL was not found.
Private Const SE_ERR_FNF = 2    'The specified file was not found.
Private Const SE_ERR_NOASSOC = 31    'There is no application associated with the given file name extension. This error will also be
                                     '  returned if you attempt to print a file that is not printable.
Private Const SE_ERR_OOM = 8    'There was not enough memory to complete the operation.
Private Const SE_ERR_PNF = 3    'The specified path was not found.
Private Const SE_ERR_SHARE = 26    'A sharing violation occurred.

'OpenURL3 "
'OpenURL3 "C:\Users\Microsoft\Documents\Test.pdf" -> launches in system default app
'OpenURL3 "C:\Users\Microsoft\Documents\Image.jpg" -> launches in system default app
'***Reports of issues in which URL is passed as lowercase causing issues with certain case sensitive URLs***
Public Sub OpenURL3(ByVal sURL As String)
    Dim lRetVal               As Long

    'lpOperation can be: edit, explore, find, open, print, runas
    lRetVal = ShellExecute(0, "open", sURL, "", "", SW_SHOWNORMAL)
    Select Case lRetVal
        Case Is > SE_ERR_DLLNOTFOUND 'If the function succeeds, it returns a value greater than 32
            'Success
        Case ERROR_FILE_NOT_FOUND
            MsgBox "File not found"
        Case ERROR_PATH_NOT_FOUND
            MsgBox "Path not found"
        Case ERROR_BAD_FORMAT
            MsgBox "Bad format."
    End Select
End Sub

Objeto de shell

Otra opción es usar el objeto de shell para llamar al método ShellexCute.

'OpenURL4 "
'OpenURL4 "C:\Users\Microsoft\Documents\Test.pdf" -> launches in system default app
'OpenURL4 "C:\Users\Microsoft\Documents\Image.jpg" -> launches in system default app
Public Sub OpenURL4(ByVal sURL As String)
    '
    Dim oShell As Object

    Set oShell = CreateObject("Shell.Application")
    oShell.ShellExecute sURL, "", "", "open", 1
    If Not oShell Is Nothing Then Set oShell = Nothing
End Sub

Otro enfoque de objeto de shell para abrir archivos/URL es:

Public Function OpenURL5(ByVal sURL As String) As Boolean
    On Error GoTo Error_Handler
    Dim oShell                As Object
    Dim oFolder               As Object
    Dim oFile                 As Object
    Dim sFolderPath           As String
    Dim sFileName             As String

    Set oShell = CreateObject("Shell.Application")

    If Left(sURL, 4) = "www." Then sURL = " & sURL
    If Left(sURL, 4) = "http" Or Left(sURL, 7) = "mailto:" Then
        ' Open URL
        oShell.NameSpace(0).ParseName(sURL).InvokeVerb "Open"
    Else
        ' Open file
        sFolderPath = Left(sURL, InStrRev(sURL, "\"))
        sFileName = Mid(sURL, InStrRev(sURL, "\") + 1)

        Set oFolder = oShell.NameSpace((sFolderPath))
        If Not oFolder Is Nothing Then
            Set oFile = oFolder.ParseName(sFileName)
            If Not oFile Is Nothing Then
                oFile.InvokeVerb "Open"
            Else
                Debug.Print "File not found: " & sURL
                GoTo Error_Handler_Exit
            End If
        Else
            Debug.Print "Folder not found: " & sFolderPath
            GoTo Error_Handler_Exit
        End If
    End If

    OpenURL5 = True

Error_Handler_Exit:
    On Error Resume Next
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oShell = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: OpenURL5" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Otro enfoque de objeto de shell es:

Public Sub OpenURL6(ByVal sURL As String)
    Dim oShell As Object
    
    ' Perhaps add a check that the file exists here first

    Set oShell = CreateObject("Shell.Application")
    oShell.Open (sURL)
    If Not oShell Is Nothing Then Set oShell = Nothing
End Sub

Los tres son similares a la API de ShellexCute, ¡pero no necesita llevar la declaración de la API! Estas parecerían ser las soluciones más simples y ninguna o ellos sufre de los mensajes de advertencia que el método FollowHyperlink.

Otros recursos

• Aplicación.
• API ShellexCute
• Método ShellexCute

Historial de la página