VBA使用命令按钮打开现有文件夹-解网

问：

下面的代码无法识别现有文件夹。我测试了搜索工单编号 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)

行动

打开用户表单
搜索工单编号（例如：MSO-40550）
单击命令按钮以在 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

VBA 按钮目录命令

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

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

VBA Open Existing Folder with Command Button

评论

评论