Question

我在VBA中遇到问题，我想根据组合框值获取文件夹的路径。

看，我有一张名为“TAG”的excel表格，在第一栏中我有很多价值，如P36300000，C36300001等。（下图）

我创建了一个循环遍历工作表列的宏，并根据每个单元格值创建一个文件夹。

“P”表示它是主要项目，而“C”表示它只是项目的一个组成部分。

即，它会创建 P36300000 文件夹，其中包含： 3C6300001，C36300002，C36300003，C36300004，C36300005，C36300006 ， P36300007 包含 C36300008

Folder Lists

每个（主文件夹和组件）都有一个DT文件夹，其中有一个excel文件。（不是骄傲，但为了以防万一）

组件的路径应该是这样的的 H：\工作\项目\ 2017 \ A1 \ P36300000 \ C36300001

主要的东西就像的 H：\工作\项目\ 2017 \ A1 \ P36300000

我的代码是这样的，但是，它无法获取组件文件夹，只能获得主文件夹。

Option Explicit

Private Sub btnPath_Click()

    Dim MyValue As String
    Dim subFldr As Object
    Dim msg As String
    Dim fldr As String

    Worksheets("TAG").Visible = True
    MyValue = cmbTAG.Value                      ' Selected Value of the cmbBOX

    fldr = ActiveWorkbook.Path & "\2017"

    If (Left(cmbTAG.Value, 1) = "P") Then       ' If the Folder is Primary

        fldr = ActiveWorkbook.Path & "\2017\A1"

        If Dir(fldr, vbDirectory) <> "" Then
            For Each subFldr In CreateObject("Scripting.FileSystemobject").GetFolder(fldr).Subfolders
                If subFldr Like "*\" & MyValue Then msg = subFldr.Name
            Next subFldr

            txtRutaPadre.Text = fldr & "\" & msg
            txtRutaDT.Text = fldr & "\" & msg & "\DT"
        End If

    ElseIf (Left(cmbTAG.Value, 1) = "C") Then   ' if it is a Component.

        fldr = ActiveWorkbook.Path & "\2017\A1"

        If Dir(fldr, vbDirectory) <> "" Then
            For Each subFldr In CreateObject("Scripting.FileSystemobject").GetFolder(fldr).Subfolders
                If subFldr Like "*\" & MyValue Then msg = subFldr.Name
            Next subFldr

            txtPrimary.Text = fldr & "\" & msg
            txtDT.Text = fldr & "\" & msg & "\DT"
        End If
    End If
End Sub

谢谢你的时间！

Answer 1

您找不到C文件夹的原因是因为您正在寻找与P文件夹处于同一级别的C文件夹，而您应该更深层次地查找。这是您的代码在查找C文件夹时的样子。此外，一旦找到您要找的东西，我就会退出For循环。

Sub test()
    Dim msg As String
    Dim fldr As String
    Dim MyValue As String
    Dim subFldr As Object
    Dim subsubFldr As Object
    Dim pFolder As String
    Dim cFolder As String

    MyValue = Worksheets(1).Range("A1").Value                     ' Selected Value of the cmbBOX
    Debug.Print MyValue
    fldr = "C:\Users\GAC-Phillip\Dropbox"

    If Dir(fldr, vbDirectory) <> "" Then
        For Each subFldr In CreateObject("Scripting.FileSystemobject").GetFolder(fldr).Subfolders
            For Each subsubFldr In CreateObject("Scripting.FileSystemobject").GetFolder(subFldr).Subfolders
                Debug.Print subsubFldr
                If subsubFldr Like "*\" & MyValue Then
                    MsgBox ("found folder!" & vbNewLine & subsubFldr)
                    cFolder = subsubFldr.Path
                    GoTo FoundFolder
                End If
            Next subsubFldr
        Next subFldr
    End If

FoundFolder:
    pFolder = extract_P_folder(cFolder)
    MsgBox (pFolder)
End Sub


Function extract_P_folder(ByRef filePath As String) As String
    Dim TestArray() As String
    TestArray = Split(filePath, "\")
    extract_P_folder = TestArray(UBound(TestArray) - 1)
    Debug.Print extract_P_folder  ' for double checking in development
End Function

<强>更新我已根据您对以前发布的答案的评论添加了extract_P_folder函数。这将返回传入的文件路径的父文件夹。

Answer 2

如果有人在将来研究这个......

此代码从所选目录开始，并生成一个包含所有第一级子目录中所有文件的数组。

每个数组条目都包含文件名及其父目录名

使用系统CMD调用

Option Explicit

' this sub pulls a list of first level subdirectories in a particular directory
' and returns an array containing the subdirectory name and a containing filename
' returns one entry for each filename found inside the subdirectories

Sub aaa()
'   Dim shel As WshShell            ' early binding, requires reference to "windows script host object model"
    Dim shel As Object
    Set shel = VBA.CreateObject("WScript.Shell")

    Dim startDir As String
    startDir = "C:\Users\xxxx\Desktop\excelWork"

    Dim cmd As String

    cmd = "cmd /c cd /D " & startDir _
        & " & " _
        & "@for /f ""tokens=1"" %a in ('dir . /a:d /b') " _
        & "do " _
        & "@for /f ""tokens=1"" %b in ('dir .\%a /a:-d /b') " _
        & "do " _
        & "@echo %a?%b"  ' the question mark is a separator that will never be found in a microsoft filename

        ' microsoft invalid filename characters \/:*?"<>|

    Dim op As Variant
    op = Split(shel.Exec(cmd).StdOut.ReadAll(), vbCrLf)     ' convert to array, one line per element

    Dim numFiles As Integer
    numFiles = UBound(op)

    ReDim files(numFiles) As Variant

    Dim i As Integer
    For i = 0 To numFiles
        files(i) = Split(op(i), "?")                        ' split each line into parent directory and filename pair
    Next i

    MsgBox files(0)(0) & " --- " & files(0)(1)              ' print first entry

End Sub

使用组合框基于单元格值定位文件夹路径

2 个答案: