☰

使用 VBA 宏创建文件夹和子文件夹

tag-icon • tag-icon microsoft-excel vba
使用 VBA 宏创建文件夹和子文件夹

我希望使用我创建的电子表格根据每列的内容生成文件夹和子文件夹。

第一列是顶层，第二列是下一级（子文件夹），依此类推。

    A                 B                   C                   D
1   TOP FOLDER 1      Sub Folder 1.1      Sub Folder 1.2      Sub Folder 1.3
2   TOP FOLDER 2      Sub Folder 2.1      Sub Folder 2.2      Sub Folder 2.3
3   TOP FOLDER 3      Sub Folder 3.1      Sub Folder 3.2      Sub Folder 3.3

我已经尝试过另一个程序，它创建了文件夹，但将它们全部放在一个文件夹中！我需要它有子文件夹，但我认为问题可能是分离文件夹，下面是一个例子：

我认为将子文件夹分离到其父文件夹中可能会有问题，因为它们位于同一列中......

答案1

这用 VBA 创建了一个文件夹结构。简短而美观。

Sub CreateFolderStructure()
    Dim objRow as Range, objCell as Range, strFolders as String

    For Each objRow In ActiveSheet.UsedRange.Rows
        strFolders = "C:\myRootFolder"            
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next            
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next    
End Sub

没有错误处理！

它能做什么

  1. 循环遍历活动 Excel 工作表的每一行
  2. 设置要在其中创建新文件夹的根文件夹。必须在每个循环中执行
  3. 循环遍历当前行中每个使用的单元格
  4. 用反斜杠连接根文件夹和新的子文件夹。
    对该行中的每个子文件夹执行此操作，直到我们得到类似
    "C:\myRootFolder\TOP FOLDER 1\SUB FOLDER 1.1\SUB FOLDER 1.2\SUB FOLDER 1.3"
  5. 现在，奇迹出现了。我们做到了不是使用 VBAmkdir函数。
    相反，我们使用Shell(cmd /c md)只需一个命令即可创建多个文件夹。如果文件夹已存在，也不会产生错误。多么漂亮的命令

一些注释

  • 避免在文件夹名称中出现以下字符：© ® " - & ' ^ ( ) @
  • 空的 Excel 单元格没有问题。MD 命令可以处理带有C:\root\\subfolder两个连续反斜杠的字符串
  • 文件夹名称中的空格没有问题，因为我们用两个引号 ( chr(34))将整个结构括起来

答案2

Sub MkDirs()

    Const RootPath = "C:\your\path"
    Dim rng As Range

    Set rng = Selection

    For Each rw In rng.Rows
        ChDir RootPath
        For Each cl In rw.Cells
            If cl <> "" Then
                MkDir cl
                ChDir cl
            End If
        Next
    Next 
End Sub

答案3

这是一个更好的答案，它允许您选择一个根文件，而不是在代码中定义它：

Sub FolderCreator()

    Dim objRow As Range, objCell As Range, strFolders As String, rootFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        ' show the file picker dialog box
        If .Show <> 0 Then
            rootFolder = .SelectedItems(1)
              End If
    End With

    For Each objRow In ActiveSheet.UsedRange.Rows
        strFolders = rootFolder
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next

End Sub

相关内容