Я хочу нажать кнопку в моей форме доступа, которая открывает папку в проводнике Windows.
Есть ли способ сделать это в VBA?
Как открыть папку в проводнике Windows из VBA?
Ответ 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