47

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

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

4

11 回答 11

59

您可以使用以下代码从 vba 打开文件位置。

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

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

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

如果您想要最大化视图，VbNormalFocus 可以与 VbMaximizedFocus 交换。

于 2012-06-26T10:49:05.317 回答
29

最简单的方法是

Application.FollowHyperlink [path]

只需要一条线！

于 2014-12-08T01:37:07.537 回答
11

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

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

其中“路径”是您要打开的文件夹。

（在此示例中，我打开保存当前工作簿的文件夹。）

优点：

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

缺点：

  • 窗口最大化（或最小化）是强制性的。

解释：

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

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

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

于 2015-09-02T17:05:01.857 回答
7

这里有一些更酷的知识：

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

这是表单上的完整代码：

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

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

如果我有代表，我会张贴一张照片......：/

我还有一些其他的东西想添加到这段代码中，但还没有机会。我想有一种方法来存储在另一个表中工作的那些，或者让用户将它们标记为可以存储。

我不能对所有代码要求完全的功劳，我从周围找到的东西中拼凑了其中的一些，甚至在 stackoverflow 上的其他帖子中也是如此。

我真的很喜欢在这里发布问题然后自己回答的想法，因为正如链接文章所说，它可以很容易地找到答案以供以后参考。

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

于 2013-05-28T07:19:35.010 回答
5

您可以使用命令提示符打开带有路径的资源管理器。

这里带有批处理或命令提示符的示例：

start "" explorer.exe (path)

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

Dim Path
Path="C:\Example"
shell "cmd /c start """" explorer.exe " & Path ,vbHide
于 2016-12-20T09:06:43.047 回答
2

由于公司的安全性，我可能不会使用 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: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

所以实际上它 

strFolder = "C:\Test Files\"

和

ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
于 2016-04-04T10:56:00.610 回答
2

这就是我所做的。

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

优点：

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

缺点：

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

如果没有打开的文件夹，这会始终打开一个窗口，如果该文件夹有一个打开的窗口，则会切换到打开的窗口。

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

于 2016-04-13T16:28:08.610 回答
0

这是一个给出开始的切换或启动行为的答案，没有命令提示符窗口。它确实有一个缺点，即它可能会被在其他地方打开同名文件夹的资源管理器窗口所欺骗。我可能会通过潜入子窗口并寻找实际路径来解决这个问题，我需要弄清楚如何导航。

用法（需要项目参考中的“Windows 脚本宿主对象模型”）：

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

模块：

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
于 2014-09-08T14:37:01.663 回答
0

私有子 Command0_Click()

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

结束子

于 2015-12-27T05:54:29.357 回答
0

我刚刚使用它，它工作正常：

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

于 2016-04-06T09:56:17.847 回答
0

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

原封不动，代码将带您进行\\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
于 2016-07-13T14:02:55.740 回答