如何從VBA打開Windows資源管理器中的文件夾？

Question

我想單擊我的訪問表單上的一個按鈕，以在 Windows Explorer 中打開一個文件夾。

VBA有什么辦法嗎？

Answer 1

您可以使用以下代碼從vba中打開文件位置。

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

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

您可以將此代碼用於Windows共享和本地驅動器。

如果要最大化視圖，可以將VbNormalFocus替換為VbMaximizedFocus。

Answer 2

最簡單的方法是

Application.FollowHyperlink [path]

僅需一行！

Answer 3

這是一些更酷的知識：

我遇到這樣的情況，我需要能夠根據記錄中的一些條件查找文件夾，然后打開找到的文件夾。 在尋找解決方案的過程中，我創建了一個小型數據庫，該數據庫要求搜索起始文件夾為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上的其他帖子中也是如此。

我真的很喜歡在這里發布問題然后自己回答的想法，因為如鏈接文章所述，它很容易找到答案供以后參考。

當我完成其他要添加的部分時，我也將發布該代碼。 :)

Answer 4

多虧了PhilHibbs的評論（關於VBwhatnow的回答），我終於找到了一個既可以重用現有窗口又可以避免向用戶刷新CMD窗口的解決方案：

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

其中“路徑”是您要打開的文件夾。

（在此示例中，我打開了保存當前工作簿的文件夾。）

優點：

• 避免打開新的資源管理器實例（僅在存在窗口時設置焦點）。
• 借助vbHide，cmd窗口將永遠不可見。
• 比較簡單（不需要引用win32庫）。

缺點：

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

說明：

最初，我嘗試僅使用vbHide。 效果很好...除非已經打開了這樣一個文件夾，否則現有文件夾窗口將被隱藏並消失！ 現在，您將在內存中浮動一個幻影窗口，此后任何隨后嘗試打開該文件夾的嘗試都會重用隱藏的窗口-似乎沒有任何作用。

換句話說，當“start'-命令找到指定vbAppWinStyle被應用到CMD-窗口和重新使用瀏覽器窗口都現有的窗口。 （因此，幸運的是，可以通過使用不同的vbAppWinStyle參數再次調用同一命令來取消隱藏窗口。）

但是，通過在調用“開始”時指定/ max或/ min標志，可以防止在CMD窗口上設置的vbAppWinStyle遞歸應用。 （或覆蓋它？我不知道技術細節是什么，我很好奇確切地知道這里的事件鏈是什么。）

Answer 5

這是我所做的。

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

優點：

• 避免打開新的資源管理器實例（僅在存在窗口時設置焦點）。
• 比較簡單（不需要引用win32庫）。
• 窗口最大化（或最小化） 不是強制性的。 窗口將以正常大小打開。

缺點：

• 該cmd窗口在短時間內可見。

如果沒有打開該文件夾，則始終打開該文件夾的窗口；如果該文件夾沒有打開，則切換到打開的窗口。

感謝PhilHibbs和AnorZaken為這一基礎。 PhilHibbs的注釋對我來說不太有效，我需要在命令字符串中的文件夾名稱前加上雙引號。 而且我更喜歡讓命令提示符窗口出現一點，而不是被迫最大化或最小化資源管理器窗口。

Answer 6

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

Answer 7

這是一個給出“開始”的切換或啟動行為的答案，而沒有“命令提示符”窗口。 它確實具有一個缺點，即可以被在其他位置打開了同名文件夾的資源管理器窗口欺騙。 我可能會通過進入子窗口並尋找實際路徑來解決此問題，我需要弄清楚如何進行導航。

用法（需要項目參考中的“ 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

Answer 8

私人子Command0_Click（）

Application.FollowHyperlink“ D：\\ 1Zsnsn \\ SusuBarokah \\ 20151008 Inventory.mdb”

結束子

Answer 9

由於公司的安全性，我可能不使用shell命令，所以這是我在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 

所以實際上它

strFolder = "C:\Test Files\"

和

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

Answer 10

我只是用這個，它工作正常：

System.Diagnostics.Process.Start（“ C：/ Users / Admin / files”）;

Answer 11

由於上面和其他地方的許多答案，這是我對與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

Answer 12

您可以使用命令提示符打開帶有路徑的資源管理器。

這是批處理或命令提示符的示例：

start "" explorer.exe (path)

因此，在VBA ms.access中，您可以編寫：

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