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

How to open a folder in Windows Explorer from VBA?

提问by VBwhatnow

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

我想单击我的访问表单上的一个按钮，以在 Windows 资源管理器中打开一个文件夹。

Is there any way to do this in VBA?

有没有办法在 VBA 中做到这一点？

回答by VBwhatnow

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

您可以使用以下代码从 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.

您可以将此代码用于 Windows 共享和本地驱动器。

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

如果您想要最大化视图，可以将 VbNormalFocus 替换为 VbMaximizedFocus。

回答by Brian Battles

The easiest way is

最简单的方法是

Application.FollowHyperlink [path]

Which only takes one line!

只需要一行！

回答by DawnTreader

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.

我遇到过一种情况，我需要能够根据记录中的一些条件找到文件夹，然后打开找到的文件夹。在寻找解决方案的工作中，我创建了一个小型数据库，要求搜索起始文件夹为 4 个条件提供位置，然后允许用户进行条件匹配，打开与输入的匹配的 4 个（或更多）可能的文件夹标准。

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.

该表单有一个基于表的子表单，该表单有 4 个用于条件的文本框、2 个指向单击过程的按钮和 1 个其他文本框，用于存储起始文件夹的字符串。有 2 个文本框用于显示列出的文件夹数量以及搜索条件时处理的数量。

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.

我不能对所有代码声明全部功劳，我从周围发现的东西中拼凑了其中的一些，即使在 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. :)

当我完成我想添加的其他部分时，我也会发布代码。:)

回答by AnorZaken

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:

感谢 PhilHibbs 评论（关于 VBwhatnow 的回答），我终于找到了一个既能重用现有窗口又能避免在用户处闪烁 CMD 窗口的解决方案：

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 nevervisible thanks to vbHide.
• Relatively simple (does not need to reference win32 libraries).

• 避免打开新的资源管理器实例（仅在窗口存在时设置焦点）。
• 多亏了 vbHide ，cmd 窗口永远不可见。
• 比较简单（不需要引用win32库）。

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.

起初我尝试只使用 vbHide。这很好用...除非已经打开了这样的文件夹，在这种情况下，现有文件夹窗口将隐藏并消失！您现在有一个幽灵窗口漂浮在内存中，之后任何打开文件夹的后续尝试都将重用隐藏的窗口 - 似乎没有任何效果。

In other words when the 'start'-command finds an existing window the specified vbAppWinStyle gets applied to boththe 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.)

换句话说，当“start'-命令找到指定vbAppWinStyle被应用于现有的窗口二者的CMD-窗口和重新使用资源管理器窗口。（幸运的是，我们可以通过使用不同的 vbAppWinStyle 参数再次调用相同的命令来取消隐藏我们的幽灵窗口。）

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.)

但是，通过在调用 'start' 时指定 /max 或 /min 标志，它可以防止在 CMD 窗口上设置的 vbAppWinStyle 被递归应用。（或覆盖它？我不知道技术细节是什么，我很想知道这里的事件链到底是什么。）

回答by DPGT

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 notmandatory. Window will open with normal size.

• 避免打开新的资源管理器实例（仅在窗口存在时设置焦点）。
• 比较简单（不需要引用win32库）。
• 窗口最大化（或最小化）不是强制性的。窗口将以正常大小打开。

Cons:

缺点：

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

• cmd 窗口在短时间内可见。

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.

感谢 PhilHibbs 和 AnorZaken 为此奠定了基础。PhilHibbs 的评论对我来说不太适用，我需要命令字符串在文件夹名称前加上一对双引号。而且我更喜欢让命令提示符窗口出现一点，而不是被迫最大化或最小化资源管理器窗口。

回答by Rafael

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

由于公司的安全性，我可能不会使用 shell 命令，所以这是我在互联网上找到的最好方法。

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:[email protected]" 
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 

回答by Hzzkygcs

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:

所以在 VBA ms.access 中你可以写：

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

回答by mojo

I just used this and it works fine:

我刚用过这个，效果很好：

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

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

回答by benJephunneh

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.

感谢上面和其他地方的许多答案，这是我对与 OP 类似问题的解决方案。我的问题是在 Word 中创建一个按钮，要求用户输入网络地址，并在资源管理器窗口中拉出 LAN 资源。

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.

原封不动，代码将带您进行\\10.1.1.1\Test,您认为合适的编辑。我只是一个键盘上的猴子，在这里，所以欢迎所有的意见和建议。

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

回答by Atlas

Private Sub Command0_Click()

私有子命令0_Click()

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

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

End Sub

结束子