如何从VBA打开Windows资源管理器中的文件夹？

Question

I want to click a button on my access form that opens a folder in Windows Explorer.

Is there any way to do this in VBA?

Answer 1

You can use the following code to open a file location from vba.

Dim Foldername As String
Foldername = "\\server\Instructions\"

Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus

You can use this code for both windows shares and local drives.

VbNormalFocus can be swapper for VbMaximizedFocus if you want a maximized view.

Answer 2

The easiest way is

Application.FollowHyperlink [path]

Which only takes one line!

Answer 3

Here is some more cool knowledge to go with this:

I had a situation where I needed to be able to find folders based on a bit of criteria in the record and then open the folder(s) that were found. While doing work on finding a solution I created a small database that asks for a search starting folder gives a place for 4 pieces of criteria and then allows the user to do criteria matching that opens the 4 (or more) possible folders that match the entered criteria.

Here is the whole code on the form:

Option Compare Database
Option Explicit

Private Sub cmdChooseFolder_Click()

    Dim inputFileDialog As FileDialog
    Dim folderChosenPath As Variant

    If MsgBox("Clear List?", vbYesNo, "Clear List") = vbYes Then DoCmd.RunSQL "DELETE * FROM tblFileList"
    Me.sfrmFolderList.Requery

    Set inputFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With inputFileDialog
        .Title = "Select Folder to Start with"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        folderChosenPath = .SelectedItems(1)
    End With

    Me.txtStartPath = folderChosenPath

    Call subListFolders(Me.txtStartPath, 1)

End Sub
Private Sub cmdFindFolderPiece_Click()

    Dim strCriteria As String
    Dim varCriteria As Variant
    Dim varIndex As Variant
    Dim intIndex As Integer

    varCriteria = Array(Nz(Me.txtSerial, "Null"), Nz(Me.txtCustomerOrder, "Null"), Nz(Me.txtAXProject, "Null"), Nz(Me.txtWorkOrder, "Null"))
    intIndex = 0

    For Each varIndex In varCriteria
        strCriteria = varCriteria(intIndex)
        If strCriteria <> "Null" Then
            Call fnFindFoldersWithCriteria(TrailingSlash(Me.txtStartPath), strCriteria, 1)
        End If
        intIndex = intIndex + 1
    Next varIndex

    Set varIndex = Nothing
    Set varCriteria = Nothing
    strCriteria = ""

End Sub
Private Function fnFindFoldersWithCriteria(ByVal strStartPath As String, ByVal strCriteria As String, intCounter As Integer)

    Dim fso As New FileSystemObject
    Dim fldrStartFolder As Folder
    Dim subfldrInStart As Folder
    Dim subfldrInSubFolder As Folder
    Dim subfldrInSubSubFolder As String
    Dim strActionLog As String

    Set fldrStartFolder = fso.GetFolder(strStartPath)

'    Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(fldrStartFolder.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

    If fnCompareCriteriaWithFolderName(fldrStartFolder.Name, strCriteria) Then
'        Debug.Print "Found and Opening: " & fldrStartFolder.Name & "Because of: " & strCriteria
        Shell "EXPLORER.EXE" & " " & Chr(34) & fldrStartFolder.Path & Chr(34), vbNormalFocus
    Else
        For Each subfldrInStart In fldrStartFolder.SubFolders

            intCounter = intCounter + 1

            Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(subfldrInStart.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

            If fnCompareCriteriaWithFolderName(subfldrInStart.Name, strCriteria) Then
'                Debug.Print "Found and Opening: " & subfldrInStart.Name & "Because of: " & strCriteria
                Shell "EXPLORER.EXE" & " " & Chr(34) & subfldrInStart.Path & Chr(34), vbNormalFocus
            Else
                Call fnFindFoldersWithCriteria(subfldrInStart, strCriteria, intCounter)
            End If
            Me.txtProcessed = intCounter
            Me.txtProcessed.Requery
        Next
    End If

    Set fldrStartFolder = Nothing
    Set subfldrInStart = Nothing
    Set subfldrInSubFolder = Nothing
    Set fso = Nothing

End Function
Private Function fnCompareCriteriaWithFolderName(strFolderName As String, strCriteria As String) As Boolean

    fnCompareCriteriaWithFolderName = False

    fnCompareCriteriaWithFolderName = InStr(1, Replace(strFolderName, " ", "", 1, , vbTextCompare), Replace(strCriteria, " ", "", 1, , vbTextCompare), vbTextCompare) > 0

End Function

Private Sub subListFolders(ByVal strFolders As String, intCounter As Integer)
    Dim dbs As Database
    Dim fso As New FileSystemObject
    Dim fldFolders As Folder
    Dim fldr As Folder
    Dim subfldr As Folder
    Dim sfldFolders As String
    Dim strSQL As String

    Set fldFolders = fso.GetFolder(TrailingSlash(strFolders))
    Set dbs = CurrentDb

    strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldFolders.Path & Chr(34) & ", " & Chr(34) & fldFolders.Name & Chr(34) & ", '" & fldFolders.Size & "')"
    dbs.Execute strSQL

    For Each fldr In fldFolders.SubFolders
        intCounter = intCounter + 1
        strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldr.Path & Chr(34) & ", " & Chr(34) & fldr.Name & Chr(34) & ", '" & fldr.Size & "')"
        dbs.Execute strSQL
        For Each subfldr In fldr.SubFolders
            intCounter = intCounter + 1
            sfldFolders = subfldr.Path
            Call subListFolders(sfldFolders, intCounter)
            Me.sfrmFolderList.Requery
        Next
        Me.txtListed = intCounter
        Me.txtListed.Requery
    Next

    Set fldFolders = Nothing
    Set fldr = Nothing
    Set subfldr = Nothing
    Set dbs = Nothing

End Sub

Private Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

The form has a subform based on the table, the form has 4 text boxes for the criteria, 2 buttons leading to the click procedures and 1 other text box to store the string for the start folder. There are 2 text boxes that are used to show the number of folders listed and the number processed when searching them for the criteria.

If I had the Rep I would post a picture... :/

I have some other things I wanted to add to this code but haven't had the chance yet. I want to have a way to store the ones that worked in another table or get the user to mark them as good to store.

I can not claim full credit for all the code, I cobbled some of it together from stuff I found all around, even in other posts on stackoverflow.

I really like the idea of posting questions here and then answering them yourself because as the linked article says, it makes it easy to find the answer for later reference.

When I finish the other parts I want to add I will post the code for that too. :)

Answer 4

Thanks to PhilHibbs comment (on VBwhatnow's answer) I was finally able to find a solution that both reuses existing windows and avoids flashing a CMD-window at the user:

Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide

where 'path' is the folder you want to open.

(In this example I open the folder where the current workbook is saved.)

Pros:

• Avoids opening new explorer instances (only sets focus if window exists).
• The cmd-window is never visible thanks to vbHide.
• Relatively simple (does not need to reference win32 libraries).

Cons:

• Window maximization (or minimization) is mandatory.

Explanation:

At first I tried using only vbHide. This works nicely... unless there is already such a folder opened, in which case the existing folder window becomes hidden and disappears! You now have a ghost window floating around in memory and any subsequent attempt to open the folder after that will reuse the hidden window - seemingly having no effect.

In other words when the 'start'-command finds an existing window the specified vbAppWinStyle gets applied to both the CMD-window and the reused explorer window. (So luckily we can use this to un-hide our ghost-window by calling the same command again with a different vbAppWinStyle argument.)

However by specifying the /max or /min flag when calling 'start' it prevents the vbAppWinStyle set on the CMD window from being applied recursively. (Or overrides it? I don't know what the technical details are and I'm curious to know exactly what the chain of events is here.)

Answer 5

Here is what I did.

Dim strPath As String
strPath = "\\server\Instructions\"    
Shell "cmd.exe /c start """" """ & strPath & """", vbNormalFocus

Pros:

• Avoids opening new explorer instances (only sets focus if window exists).
• Relatively simple (does not need to reference win32 libraries).
• Window maximization (or minimization) is not mandatory. Window will open with normal size.

Cons:

• The cmd-window is visible for a short time.

This consistently opens a window to the folder if there is none open and switches to the open window if there is one open to that folder.

Thanks to PhilHibbs and AnorZaken for the basis for this. PhilHibbs comment didn't quite work for me, I needed to the command string to have a pair of double quotes before the folder name. And I preferred having a command prompt window appear for a bit rather than be forced to have the Explorer window maximized or minimized.

Answer 6

Shell "C:\WINDOWS\explorer.exe /select,""" & ActiveWorkbook.Name & "", vbNormalFocus

Answer 7

Here's an answer that gives the switch-or-launch behaviour of Start, without the Command Prompt window. It does have the drawback that it can be fooled by an Explorer window that has a folder of the same name elsewhere opened. I might fix that by diving into the child windows and looking for the actual path, I need to figure out how to navigate that.

Usage (requires "Windows Script Host Object Model" in your project's References):

Dim mShell As wshShell

mDocPath = whatever_path & "\" & lastfoldername
mExplorerPath = mShell.ExpandEnvironmentStrings("%SystemRoot%") & "\Explorer.exe"

If Not SwitchToFolder(lastfoldername) Then
    Shell PathName:=mExplorerPath & " """ & mDocPath & """", WindowStyle:=vbNormalFocus
End If

Module:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal lngHWnd As Long) As Long

Function SwitchToFolder(pFolder As String) As Boolean

Dim hWnd As Long
Dim mRet As Long
Dim mText As String
Dim mWinClass As String
Dim mWinTitle As String

    SwitchToFolder = False

    hWnd = FindWindowEx(0, 0&, vbNullString, vbNullString)
    While hWnd <> 0 And SwitchToFolder = False
        mText = String(100, Chr(0))
        mRet = GetClassName(hWnd, mText, 100)
        mWinClass = Left(mText, mRet)
        If mWinClass = "CabinetWClass" Then
            mText = String(100, Chr(0))
            mRet = GetWindowText(hWnd, mText, 100)
            If mRet > 0 Then
                mWinTitle = Left(mText, mRet)
                If UCase(mWinTitle) = UCase(pFolder) Or _
                   UCase(Right(mWinTitle, Len(pFolder) + 1)) = "\" & UCase(pFolder) Then
                    BringWindowToTop hWnd
                    SwitchToFolder = True
                End If
            End If
        End If
        hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString)
    Wend

End Function

Answer 8

Private Sub Command0_Click()

Application.FollowHyperlink "D:\\1Zsnsn\\SusuBarokah\\20151008 Inventory.mdb"

End Sub

Answer 9

I may not use shell command because of security in the company so the best way I found on internet.

Sub OpenFileOrFolderOrWebsite() 
'Shows how to open files and / or folders and / or websites / or create    emails using the FollowHyperlink method
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.blalba.com/" 

strEmail = "mailto:YourEmailHere@Website.com" 
strSubject = "?subject=Test" 
strEmailHyperlink = strEmail & strSubject 

 '**************FEEL FREE TO COMMENT ANY OF THESE TO TEST JUST ONE ITEM*********
 'Open Folder
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True 
 'Open excel workbook
ActiveWorkbook.FollowHyperlink Address:=strXLSFile, NewWindow:=True 
 'Open PDF file
ActiveWorkbook.FollowHyperlink Address:=strPDFFile, NewWindow:=True 
 'Open VBAX
ActiveWorkbook.FollowHyperlink Address:=strWebsite, NewWindow:=True 
 'Create New Email
ActiveWorkbook.FollowHyperlink Address:=strEmailHyperlink, NewWindow:=True 
 '******************************************************************************
End Sub 

so actually its

strFolder = "C:\Test Files\"

and

ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True 

Answer 10

I just used this and it works fine:

System.Diagnostics.Process.Start("C:/Users/Admin/files");

Answer 11

Thanks to many of the answers above and elsewhere, this was my solution to a similar problem to the OP. The problem for me was creating a button in Word that asks the user for a network address, and pulls up the LAN resources in an Explorer window.

Untouched, the code would take you to \\\\10.1.1.1\\Test, so edit as you see fit. I'm just a monkey on a keyboard, here, so all comments and suggestions are welcome.

Private Sub CommandButton1_Click()
    Dim ipAddress As Variant
    On Error GoTo ErrorHandler

    ipAddress = InputBox("Please enter the IP address of the network resource:", "Explore a network resource", "\\10.1.1.1")
    If ipAddress <> "" Then
        ThisDocument.FollowHyperlink ipAddress & "\Test"
    End If

    ExitPoint:
        Exit Sub

    ErrorHandler:
        If Err.Number = "4120" Then
            GoTo ExitPoint
        ElseIf Err.Number = "4198" Then
            MsgBox "Destination unavailable"
            GoTo ExitPoint
        End If

        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume ExitPoint

End Sub

Answer 12

You can use command prompt to open explorer with path.

here example with batch or command prompt:

start "" explorer.exe (path)

so In VBA ms.access you can write with:

Dim Path
Path="C:\Example"
shell "cmd /c start """" explorer.exe " & Path ,vbHide