Question

我是这里的新手，非常高兴认识你。希望我能在这里得到一些教训，我也会有所帮助。

好的，那么，让我们直接回答这个问题。当我工作时，我应该创建一些包含许多子文件夹的文件夹结构。为方便起见，我们的经理在Excel 2010中使用VBA创建了一些vba脚本，但他现在退出了。在大多数情况下，我使用该文件创建了文件夹结构。当我这样做时，我从excel表的下拉列表中选择“Mobile”或“Monitor”，然后得到结果。

1_Query

2_File

3_INI

5_Reference

6_TM

7_Log

8_PO

创建上述文件夹结构的脚本如下所示。

Dim Fieldname As String

Sub Load_Click()

Dim Y_Field As Integer
Dim B_strPath As String

    If ActiveSheet.Cells(1, 8).Value <> "" Then
    B_strPath = ActiveSheet.Cells(1, 8)
    MkDir (B_strPath & "\1_From_Client")
    MkDir (B_strPath & "\1_From_Client\3_TM")
    MkDir (B_strPath & "\1_From_Client\4_Log")
    MkDir (B_strPath & "\2_To_TR")
    MkDir (B_strPath & "\3_query")
    MkDir (B_strPath & "\4_revised")
    MkDir (B_strPath & "\5_From_TR")
    MkDir (B_strPath & "\6_To_Client")
    MkDir (B_strPath & "\7_TM")
    MkDir (B_strPath & "\8_PO")
    MkDir (B_strPath & "\9_Invoice")

        Worksheets("Make DIR").Activate
        CellV1 = Cells(5, 5).Value

        For X = 3 To 4000
            If Worksheets("Project").Cells(X, 3).Value = CellV1 Then
                cellv = Worksheets("Project").Cells(X, 7).Offset(0, 0).Value
                'MsgBox cellv
                Fieldname = Worksheets("Project").Cells(X, 6).Offset(0, 0).Value
                TTT

            End If

        Next X
        Else
        MsgBox "select folder first"

    End If


End Sub

Sub TTT()
Dim strPath As String
Dim strPath_Division As String
Dim SrceFile
Dim DestFile

 'MsgBox Fieldname
 strPath = ActiveSheet.Cells(1, 8)
 strPath_Division = ActiveSheet.Cells(8, 5)


 MkDir (strPath & "\2_To_TR\" & Fieldname)
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\_Query")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\2_File")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\3_INI")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\5_Reference")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\6_TM")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\7_Log")
 MkDir (strPath & "\2_To_TR\" & Fieldname & "\8_PO")
 MkDir (strPath & "\6_To_Client\" & Fieldname)

  If strPath_Division = "Mobile" Then
    MkDir (strPath & "\2_To_TR\" & Fieldname & "\4_Term")
    SrceFile = "D:\_Project\_Term\_Mobile\Mobile_Common_Term_130115_" & Fieldname & ".xlsx"
    DestFile = strPath & "\2_To_TR\" & Fieldname & "\4_Term\Mobile_Common_Term_130115_" & Fieldname & ".xlsx"
    FileCopy SrceFile, DestFile
    Else
    MkDir (strPath & "\2_To_TR\" & Fieldname & "\4_Term")
  End If

但是最近，我应该重新安排脚本，从下拉列表中添加一些带有'BOX'的文件夹结构，如下所示。

2_File

8_PO

为此，我自己添加了一些脚本，但它无法正常工作。我添加的脚本如下所示。

Sub BOX()
Dim strPath As String
Dim strPath_Division As String
Dim SrceFile
Dim DestFile

 'MsgBox Fieldname
 strPath = ActiveSheet.Cells(1, 8)
 strPath_Division = ActiveSheet.Cells(8, 5)

 If strPath_Division = "BOX" Then
   MkDir (strPath & "\2_To_TR\" & Fieldname)
   MkDir (strPath & "\2_To_TR\" & Fieldname & "\2_File")
   MkDir (strPath & "\2_To_TR\" & Fieldname & "\8_PO")
   MkDir (strPath & "\6_To_Client\" & Fieldname)
 End If


End Sub

好吧，因为我这里没有任何代表，我只是在这里复制并粘贴脚本。并希望它不会给您带来任何不便，并希望我能从你们所有人那里获得很好的教训。

我提前感谢您的理解和奉献。

Answer 1

不确定这是不是你问的但是我把它清理了一下，并且更容易添加更多的子文件夹：

gpg --sign

Option Explicit

Dim fieldName As String

Sub makeForders()
    Dim i As Long, wsDir As Worksheet, wsPrj As Worksheet, mainPath As String

    Set wsDir = Worksheets("Make DIR")
    Set wsPrj = Worksheets("Project")
    If Len(ActiveSheet.Cells(1, 8).Value) > 0 Then
        mainPath = ActiveSheet.Cells(1, 8)
        If Len(Dir(mainPath & "1_From_Client", vbDirectory)) = 0 Then
            MkDir mainPath & "1_From_Client"
            MkDir mainPath & "1_From_Client\3_TM"
            MkDir mainPath & "1_From_Client\4_Log"
            MkDir mainPath & "2_To_TR"
            MkDir mainPath & "3_query"
            MkDir mainPath & "4_revised"
            MkDir mainPath & "5_From_TR"
            MkDir mainPath & "6_To_Client"
            MkDir mainPath & "7_TM"
            MkDir mainPath & "8_PO"
            MkDir mainPath & "9_Invoice"
        End If
        For i = 3 To 4000
            If wsPrj.Cells(i, 3).Value = wsDir.Cells(5, 5).Value Then
                makeSubForders wsPrj.Cells(i, 6).Value
            End If
        Next
    Else
        MsgBox "Select folder first"
    End If
End Sub

想知道如何在Excel 2010中使用VBA创建文件夹

1 个答案: