[英]VBA - How to open folder without knowing the full name
我正在尝试打开一个我不知道完整路径的文件夹。
例如,父文件夹 dir 是“D:\Documents”,而我要打开的文件夹名为“22.111 - PROJECT_NAME”,我知道其中的代码,但不知道名称。 我试过用“*”,但没有运气。
Sub OpenFolder()
On Error GoTo Err_cmdExplore_Click
Dim Code As String
Code = Range("A1").Value
GoToFolder = "C:\Windows\explorer.exe D:\Documents\" & Code & "*"
Call Shell(GoToFolder, 1)
Exit_cmdExplore_Click:
Exit Sub
Err_cmdExplore_Click:
MsgBox ("Pasta não encontrada")
Resume Exit_cmdExplore_Click
End Sub
在另一个论坛 (mrexcel.com) 上找到了答案,将其留给面临相同问题的任何人:
Public Sub Find_and_Open_Folder()
Dim Code As String
Dim targetFolder As String
Code = Range("A1").Value
targetFolder = Dir("D:\Documents\" & Code & "*", vbDirectory)
If targetFolder <> vbNullString Then
Shell "explorer.exe """ & "D:\Documents\" & targetFolder & """", vbNormalFocus
Else
MsgBox "Folder matching D:\Documents\" & Code & "* not found"
End If
End Sub
有了可用的父文件夹并且知道子文件夹以22.111
,您可以遍历父文件夹中的所有子文件夹,并使用InStr
列出所有可能的匹配项。 您如何执行此操作的示例:
Sub CodeSnippet()
Dim myFolderName As String
'GetFolders returns array
Dim folderNamesWithPattern As Variant
'searching for "22.111" at 1st pos in string of potential subfolder
folderNamesWithPattern = GetFolders("D:\Documents", "22.111", 1)
If UBound(folderNamesWithPattern) > 0 Then
'more than one folder that meets your pattern:
'decide what to do
Else
'only one entry in array, this is your folder or if "" then ( no such folder | parent folder does not exist )
myFolderName = folderNamesWithPattern(0)
End If
End Sub
Function GetFolders(strDirectory As String, pattern As String, position As Long) As Variant
Dim objFSO As Object
Dim objFolders As Object
Dim objFolder As Object
'create filesystem obj
Set objFSO = CreateObject("Scripting.FileSystemObject")
'create folder obj and access subfolders property
On Error GoTo errorHandler
Set objFolders = objFSO.GetFolder(strDirectory).SubFolders
'dim array for matches
Dim arrFolderNames() As Variant
arrFolderNames = Array()
'loop through all folders
For Each objFolder In objFolders
'InStr() returns 0 if not found | index 1st char in string if found
If InStr(objFolder.Name, pattern) = 1 Then
'add match to array
ReDim Preserve arrFolderNames(UBound(arrFolderNames) + 1)
arrFolderNames(UBound(arrFolderNames)) = objFolder.Name
End If
Next objFolder
'assign array for return
GetFolders = arrFolderNames
errorHandler:
If objFolders Is Nothing Then
'parent folder does not exist
GetFolders = Array("")
ElseIf UBound(arrFolderNames) = -1 Then
'we never found a subfolder that starts with pattern
GetFolders = Array("")
End If
End Function
如果您想使用 RegEx,您可能需要查看How do i use regex using instr in VBA 。
Workbook.FollowHyperlink
浏览文件夹 包含此代码的工作簿中的已知工作表 ( ThisWorkbook
)
Sub ExploreFolder()
Const iFolderPath As String = "D:\Documents\"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim Code As String: Code = CStr(ws.Range("A1").Value)
Dim dFolderPattern As String: dFolderPattern = iFolderPath & Code & "*"
Dim dFolder As String: dFolder = Dir(dFolderPattern, vbDirectory)
If Len(dFolder) > 0 Then
wb.FollowHyperlink iFolderPath & dFolder
Else
MsgBox "A folder matching the pattern '" & dFolderPattern _
& "' was not found.", vbCritical, "Explore Folder"
End If
End Sub
ActiveSheet
(不推荐)
Sub ExploreFolderActiveSheet()
Const iFolderPath As String = "D:\Documents\"
Dim ws As Worksheet: Set ws = ActiveSheet
Dim Code As String: Code = CStr(ws.Range("A1").Value)
Dim dFolderPattern As String: dFolderPattern = iFolderPath & Code & "*"
Dim dFolder As String: dFolder = Dir(dFolderPattern, vbDirectory)
If Len(dFolder) > 0 Then
ws.Parent.FollowHyperlink iFolderPath & dFolder
Else
MsgBox "A folder matching the pattern '" & dFolderPattern _
& "' was not found.", vbCritical, "Explore Folder"
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.