Bom dia!!

De acordo com a resposta em: http://profwillianexcel.forumeiros.com/t307-abrir-pasta-de-documentos-com-um-botao

Tente adaptar...
Fonte: http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

Option Explicit 
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant 
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object 
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _ 
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt) 
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next 
    BrowseForFolder = ShellApp.self.Path 
    On Error Goto 0 
     
     'Destroy the Shell Application
    Set ShellApp = Nothing 
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\ (as in \servernamesharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1) 
    Case Is = ":" 
        If Left(BrowseForFolder, 1) = ":" Then Goto Invalid 
    Case Is = "" 
        If Not Left(BrowseForFolder, 1) = "" Then Goto Invalid 
    Case Else 
        Goto Invalid 
    End Select 
     
    Exit Function 
     
Invalid: 
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False 
     
End Function 

Bom dia, há tempos utilizo para abertura de arquivos, pastas e websites um código que consegui num site referente a excel vba.
Talvez possa ajudá-lo.

Coloque-o em um módulo:

'Procedimento para abrir arquivos, pastas websites ou criar e-mails
Sub OpenFileOrFolderOrWebsite()
Dim strXLSFile As String, strPDFFile As String, strFolder As String, strWebsite As String
Dim strEmail As String, strSubject As String, strEmailHyperlink As String
strFolder = "C:Test Files"
strXLSFile = strFolder & "Test1.xls"
strPDFFile = strFolder & "Test.pdf"
strWebsite = "http://www.ebara.com.br"
strEmail = "mailto:YourEmailHere@Website.com"
strSubject = "?subject=Test"
strEmailHyperlink = strEmail & strSubject

'Abrir pastas
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
'Abrir pasta do excel
ActiveWorkbook.FollowHyperlink Address:=strXLSFile, NewWindow:=True
'Abrir arquivos PDF
ActiveWorkbook.FollowHyperlink Address:=strPDFFile, NewWindow:=True
'Abrir Website
ActiveWorkbook.FollowHyperlink Address:=strWebsite, NewWindow:=True
'Criar novo e-mail
ActiveWorkbook.FollowHyperlink Address:=strEmailHyperlink, NewWindow:=True
End Sub

Em seguida, chame essa subrotina em um botão:

'Abre o arquivo desejado
Private Sub CommandButton1_Click()
OpenFileOrFolderOrWebsite
End Sub

Abraço!