VBw*_*now 40
您可以使用以下代码从vba打开文件位置.
Dim Foldername As String
Foldername = "\\server\Instructions\"
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
您可以将此代码用于Windows共享和本地驱动器.
如果您想要最大化视图,VbNormalFocus可以是VbMaximizedFocus的交换器.
小智 18
最简单的方法是
Application.FollowHyperlink [path]
这只需要一行!
小智 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个文本框用于显示列出的文件夹数和搜索条件时处理的数字.
如果我有Rep我会张贴一张图片......:/
我还有一些其他想要添加到此代码中的东西,但还没有机会.我希望有一种方法来存储,在另一台工作的那些或得到用户将它们标记为好店.
我无法完全承认所有代码,我将其中的一些拼凑在一起我从周围找到的东西,甚至在stackoverflow上的其他帖子中.
我非常喜欢在这里发布问题然后自己回答问题的想法,因为正如链接文章所说,它可以很容易地找到答案供以后参考.
当我完成我要添加的其他部分时,我也会发布代码.:)
感谢PhilHibbs的评论(关于VBwhatnow的回答)我终于找到了一个解决方案,它既重用了现有的窗口又避免了闪烁用户的CMD窗口:
Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide
其中'path'是您要打开的文件夹.
(在此示例中,我打开保存当前工作簿的文件夹.)
优点:
缺点:
起初我尝试只使用vbHide.这很好用...除非已经打开了这样的文件夹,在这种情况下,现有的文件夹窗口会隐藏并消失!你现在有一个鬼窗口在内存中浮动,之后任何后续尝试打开文件夹将重用隐藏的窗口 - 似乎没有任何影响.
换句话说,当"start'-命令找到指定vbAppWinStyle被应用于现有的窗口二者的CMD-窗口和重新使用资源管理器窗口.(幸运的是,我们可以通过使用不同的vbAppWinStyle参数再次调用相同的命令来使用它来隐藏我们的ghost窗口.)
但是,通过在调用"start"时指定/ max或/ min标志,可以防止在CMD窗口上设置的vbAppWinStyle被递归应用.(或者覆盖它？我不知道技术细节是什么,我很想知道这里的事件链是什么.)
您可以使用命令提示符打开带有路径的资源管理器。
这里是带有批处理或命令提示符的示例：
start "" explorer.exe (path)
所以在 VBA ms.access 中你可以这样写：
Dim Path
Path="C:\Example"
shell "cmd /c start """" explorer.exe " & Path ,vbHide