Подтвердить что ты не робот

Как открыть папку в проводнике Windows из VBA?

Я хочу нажать кнопку в моей форме доступа, которая открывает папку в проводнике Windows.

Есть ли способ сделать это в VBA?

4b9b3361

ОТВЕТЫ

Ответ 1

Вы можете использовать следующий код, чтобы открыть местоположение файла из vba.

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

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

Вы можете использовать этот код для общих ресурсов Windows и локальных дисков.

VbNormalFocus может быть swapper для VbMaximizedFocus, если вы хотите получить максимальный вид.

Ответ 2

Самый простой способ -

Application.FollowHyperlink [path]

Которая занимает только одну строку!

Ответ 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 кнопки, ведущие к процедурам кликов, и еще одно текстовое поле для хранения строки для начальной папки. Есть 2 текстовых поля, которые используются для отображения количества перечисленных папок и числа, обрабатываемого при поиске по критериям.

Если бы у меня был Rep, я бы опубликовал фотографию...:/

У меня есть еще кое-что, что я хотел добавить к этому коду, но пока у меня еще не было шанса. Я хочу иметь способ сохранить те, которые работают в другой таблице, или заставить пользователя отмечать их как хорошие для хранения.

Я не могу претендовать на полный кредит для всего кода, я собрал некоторые из них из материалов, которые я нашел повсюду, даже в других сообщениях в stackoverflow.

Мне очень нравится идея размещения вопросов здесь, а затем, отвечая им самим, потому что, как говорится в статье, она позволяет легко найти ответ для последующей справки.

Когда я закончу другие части, которые я хочу добавить, я также отправлю код для этого.:)

Ответ 4

Благодаря комментарию PhilHibbs (на ответ VBwhatnow) я наконец смог найти решение, которое повторно использует существующие окна и позволяет избежать проблеска CMD-окна у пользователя:

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

где "путь" - это папка, которую вы хотите открыть.

(В этом примере я открываю папку, в которой сохраняется текущая книга.)

Плюсы:

  • Предотвращает открытие новых экземпляров explorer (только устанавливает фокус, если существует окно).
  • CMd-окно никогда видно благодаря vbHide.
  • Относительно просто (не нужно ссылаться на библиотеки win32).

Минусы:

  • Максимизация (или минимизация) окна обязательна.

Объяснение:

Сначала я попытался использовать только vbHide. Это хорошо работает... если не открыта такая папка, в этом случае существующее окно папки скрывается и исчезает! Теперь у вас есть окно-призрак, плавающее в памяти, и любая последующая попытка открыть папку после этого будет повторно использовать скрытое окно - похоже, не имеет никакого эффекта.

Другими словами, когда команда "start" находит существующее окно, указанный vbAppWinStyle применяется как к CMD-окну, так и к окну повторно используемого проводника. (Так что, к счастью, мы можем использовать это, чтобы отменить наше призрачное окно, снова вызвав ту же команду с другим аргументом vbAppWinStyle.)

Однако, указывая флаг /max или/min при вызове 'start', он запрещает использование vbAppWinStyle в окне CMD рекурсивно. (Или переопределяет это? Я не знаю, что такое технические детали, и мне любопытно узнать, что такое цепочка событий здесь.)

Ответ 5

Здесь приведен ответ, который дает поведение запуска или запуска Start, без окна командной строки. У этого есть недостаток, что его можно обмануть окном проводника, в котором есть папка с тем же именем в другом месте. Я мог бы исправить это, погрузившись в дочерние окна и ища фактический путь, мне нужно выяснить, как его перемещать.

Использование (требуется "Windows Script Модель объекта хоста" в вашем проекте.):

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

Ответ 6

Private Sub Command0_Click()

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

Конец Sub

Ответ 7

Я не могу использовать команду оболочки из-за безопасности в компании, поэтому лучший способ, который я нашел в Интернете.

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

поэтому на самом деле его

strFolder = "C:\Test Files\"

и

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

Ответ 8

Я просто использовал это, и он отлично работает:

System.Diagnostics.Process.Start( "C:/Users/Admin/файлы" );

Ответ 9

Вот что я сделал.

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

Плюсы:

  • Предотвращает открытие новых экземпляров explorer (только устанавливает фокус, если окно существует).
  • Относительно просто (не нужно ссылаться на библиотеки win32).
  • Максимизация окна (или минимизация) не обязательна не. Окно откроется с нормальным размером.

Минусы:

  • CMd-окно видно на короткое время.

Это последовательно открывает окно в папку, если нет открытого и переключается в открытое окно, если он открыт для этой папки.

Спасибо Philhibbs и AnorZaken за основу для этого. Комментарий PhilHibbs для меня не совсем сработал, мне нужно, чтобы строка команд имела пару двойных кавычек перед именем папки. И я предпочел, чтобы окно командной строки появилось для бит, а не было вынуждено иметь окно "Проводник", максимально или минимизированное.

Ответ 10

Благодаря многим ответам выше и в других местах, это было моим решением аналогичной проблемы для ОП. Проблема для меня заключалась в создании кнопки в Word, которая запрашивает у пользователя сетевой адрес и вытягивает ресурсы локальной сети в окне проводника.

Нетронутый код переместит вас на \\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

Ответ 11

Вы можете использовать командную строку для открытия проводника с помощью пути.

здесь пример с пакетной или командной строкой:

start "" explorer.exe (path)

поэтому в VBA ms.access вы можете написать с помощью

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