使用命令按钮打开现有文件夹

Question

下面的代码无法识别现有文件夹。

我测试了搜索商店订单号MSO-40550（代码仅搜索“40550”）。

将鼠标悬停在线上：

strFullPath = strP & strC & "\" & strGc & "\" & strT

显示了文件夹 40550 的正确路径：

\\cftanaus1fs01\ASO_MSO\40000-49999\40500-40599\40550

车间订单文件夹按以下层次结构组织：

 Parent Folder Name: ASO_MSO

    Child Folder Name: 40000-49999
 
       Grandchild Folder Name: 40500-40599
    
         Target Folder Name: 40550 (used in this example)

行动

1. 打开用户表单
2. 搜索商店订单号（例如：MSO-40550）
3. 单击命令按钮可在 Windows 资源管理器中打开相应的文件夹

Private Sub cmbOpenFolder_Click()
    Const strP = "\\cftanaus1fs01\ASO_MSO\" 'Parent folder
    Dim strC As String 'Child folder, ex: 40000-49999
    Dim strGc As String 'Grandchild folder, ex: 40500-40599
    Dim strT As String 'Target folder, ex: 40550
    Dim strFullPath As String 'Full path
    Dim fso As Object
    strC = Left(txtSuffix, 1) & "0000-" & Left(txtSuffix, 1) & "9999" 'Child folder, ex: 40000-49999
    strGc = Left(txtSuffix, 3) & "00-" & Left(txtSuffix, 3) & "99" 'Grandchild folder, ex: 40500-40599
    strT = txtSuffix 'Target folder, ex: 40550
    strFullPath = strP & strC & "\" & strGc & "\" & strT  'Full path
    Set fso = CreateObject("Scripting.FileSystemObject")   ' Create FileSystemObject
    If fso.FolderExists(strT) = True Then ' Check whether folder exists
       'MsgBox "Here you go!"
       Shell "explorer.exe " & strFullPath, vbNormalFocus  ' Open it
   Else
       MsgBox "This folder does not exist."
       'fso.CreateFolder strFullPath ' Code if you wanted to create a folder.
    End If
End Sub

Answer 1

这是处理文件夹分组层次结构的不同方法：

EDIT3：清理并添加了对部分文件夹名称的检查，修复了

Dir()

代码

Option Explicit

Const FOLDER_ROOT As String = "\\cftanaus1fs01\ASO_MSO\" 'Parent folder

Private Sub cmbOpenFolder_Click()
    
    Dim strFullPath As String, fso As Object, txt As String
    Set fso = CreateObject("Scripting.FileSystemObject")   ' Create FileSystemObject
    
    txt = txtSuffix 'get the user entry
    If Len(txt) > 0 Then
        strFullPath = VerifiedFolderPath(txt)
        Debug.Print "Path: " & strFullPath
        'safer to quote the folder path, in case it has spaces
        Shell "explorer.exe """ & strFullPath & """", vbNormalFocus  ' Open it
    Else
        MsgBox "Please enter a folder number", vbExclamation
    End If
End Sub

'construct and verify a folder path, checking for partial name
Function VerifiedFolderPath(srch As String) As String
    Dim i As Long, flr As Long, n, f
    i = CLng(srch)
    VerifiedFolderPath = FOLDER_ROOT           'parent folder
    For Each n In Array(10000, 100)    'loop each level of grouping
        flr = Application.Floor(i, n)
        VerifiedFolderPath = VerifiedFolderPath& flr & "-" & (flr + (n - 1)) & "\"
    Next n
    'check for existing matched folder, including partial match
    f = Dir(VerifiedFolderPath & srch & "*", vbDirectory)
    If Len(f) = 0 Then                     'not found?
        MsgBox "No folder was found matching: " & vbLf & VerifiedFolderPath & "*", _
               vbExclamation, "Folder not found"
        VerifiedFolderPath = ""                    'return empty string
    Else
        VerifiedFolderPath = VerifiedFolderPath & f & "\"  'found: add matched folder name and terminating \
    End If
End Function