根据带有组合框的单元格值查找文件夹路径 [英] Locate Folder Path Based on a Cell Value with a Combo Box

问题描述

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

I have an issue in VBA, i want to get the path of a folder based on a combo box value.

看，我有一个名为"TAG"的Excel工作表，在他的第一栏中，我有很多值，例如P36300000，C36300001等.(下图)

See, i have an excel sheet called "TAG" where in his first column i have a lot of values, like P36300000, C36300001, etc. (Image Below)

我创建了一个宏，该宏在工作表列中循环，并根据每个单元格值创建一个文件夹.

I have created a macro that loops through the sheet column and creates a folder based on each cell value.

"P"表示它是主要项目，而"C"表示它只是该项目的组成部分.

The "P" means that it's the Primary item, and the "C" means that it is just a component of that Item.

ie，它将创建 P36300000 文件夹，其中包含: 3C6300001，C36300002，C36300003，C36300004，C36300005，C36300006 ，而 P36300007 包含 C36300008 .

i.e, it creates the P36300000 folder which contains: 3C6300001, C36300002, C36300003, C36300004, C36300005, C36300006 and the P36300007 contains the C36300008.

文件夹列表

每个文件夹(主文件夹和组件)都有一个DT文件夹，一个excel文件位于该文件夹中. (不是公开的，以防万一)

Each one (Primary Folder and the Component) got a DT Folder, where an excel file is located. (Not revelant but, just in case)

组件的路径应类似于 H:\ Work \ Project \ 2017 \ A1 \ P36300000 \ C36300001

The path of the component should be something like H:\Work\Project\2017\A1\P36300000\C36300001

主要是这样的 H:\ Work \ Project \ 2017 \ A1 \ P36300000

我的代码是这样的，但是，它不能获取组件文件夹，而只能获取主文件夹.

My code is something like this, but, it can't get the Component Folder, only the Primary one.

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

感谢您的时间！

推荐答案

之所以找不到C文件夹，是因为您正在寻找与P文件夹处于同一级别的C文件夹.看起来更深层次.查找C文件夹的代码如下所示.另外，一旦您找到要节省时间的内容，我就会退出For Loop.

The reason you're not finding the C folder is because you're looking for the C folder at the same level as the P folder, when you should be looking a level deeper. Here's what your code should look like to find the C folder. Also, I would exit the For Loop once you find what you're looking for to save time.

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函数.这将返回传入文件路径的父文件夹.

UPDATE I've added the extract_P_folder function based on your comment to a previously posted answer. This will return the parent folder of the passed in file path.

这篇关于根据带有组合框的单元格值查找文件夹路径的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！