Excel VBA 自动生成文件夹框架

方案设计

1. Excel界面：

   • 在Excel中创建一个工作表，用于输入：
     • 基础路径（在哪里创建文件夹）。
     • 季度列表（例如2025Q1、2025Q2等）。
     • 子文件夹结构（例如“私募产品-基金A”“公募产品-基金S”）。
   • 添加一个按钮，运行VBA宏以生成文件夹。

2. VBA功能：

   • 读取Excel中的路径、季度和子文件夹结构。
   • 检查目标路径是否存在，若不存在则创建。
   • 循环每个季度，在路径下创建季度文件夹。
   • 在每个季度文件夹中创建相同的子文件夹结构。

3. 文件夹结构示例：

   根目录
   ├── 2025Q1
   │   ├── 私募产品
   │   │   └── 基金A
   │   └── 公募产品
   │       └── 基金S
   ├── 2025Q2
   │   ├── 私募产品
   │   │   └── 基金A
   │   └── 公募产品
   │       └── 基金S
   ...
   

---

Excel表格设置

1. 打开Excel，创建一个新工作簿。
2. 在Sheet1中设置以下结构：

A列	B列
基础路径	D:\FolderFramework
季度列表	2025Q1
	2025Q2
	2025Q3
	2025Q4
子文件夹	私募产品\基金A
	公募产品\基金S

• A1：标题“基础路径”，B1：输入目标路径（如D:\FolderFramework）。
• A2：标题“季度列表”，B2及以下：输入季度名称（如2025Q1、2025Q2等）。
• A6（或根据季度数量调整）：标题“子文件夹”，B6及以下：输入子文件夹路径（用“\”分隔层级）。

3. 保存文件为启用宏的格式（.xlsm）。

---

VBA代码

Option Explicit

Sub CreateFolderStructure()
    Dim ws As Worksheet
    Dim basePath As String
    Dim quarters As Range, quarter As Range
    Dim subFolders As Range, subFolder As Range
    Dim folderPath As String
    Dim fso As Object
    Dim i As Long, j As Long
    
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 获取基础路径
    basePath = Trim(ws.Range("B1").Value)
    If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
    
    ' 检查基础路径是否存在，不存在则创建
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(basePath) Then
        fso.CreateFolder basePath
    End If
    
    ' 获取季度列表（从B2开始，直到空单元格）
    Set quarters = ws.Range("B2", ws.Range("B2").End(xlDown))
    
    ' 获取子文件夹列表（从B6开始，直到空单元格，假设季度列表后一行是子文件夹标题）
    Set subFolders = ws.Range("B" & quarters.End(xlDown).Row + 2, ws.Range("B" & quarters.End(xlDown).Row + 2).End(xlDown))
    
    ' 循环每个季度
    For Each quarter In quarters
        If Trim(quarter.Value) <> "" Then
            ' 创建季度文件夹
            folderPath = basePath & quarter.Value
            If Not fso.FolderExists(folderPath) Then
                fso.CreateFolder folderPath
            End If
            
            ' 在季度文件夹下创建子文件夹结构
            For Each subFolder In subFolders
                If Trim(subFolder.Value) <> "" Then
                    ' 将子文件夹路径中的“\”拆分为多级目录
                    Dim subFolderArray As Variant
                    subFolderArray = Split(subFolder.Value, "\")
                    
                    Dim currentPath As String
                    currentPath = folderPath
                    
                    ' 逐级创建子文件夹
                    For j = LBound(subFolderArray) To UBound(subFolderArray)
                        currentPath = currentPath & "\" & subFolderArray(j)
                        If Not fso.FolderExists(currentPath) Then
                            fso.CreateFolder currentPath
                        End If
                    Next j
                End If
            Next subFolder
        End If
    Next quarter
    
    MsgBox "文件夹框架生成完成！", vbInformation
End Sub

---

添加运行按钮

1. 返回Excel，进入“开发工具”选项卡（若不可见，启用：文件 -> 选项 -> 自定义功能区 -> 勾选“开发工具”）。
2. 在Sheet1插入按钮：开发工具 -> 插入 -> 窗体控件 -> 按钮。
3. 将按钮命名为“生成文件夹”，右键分配宏，选择CreateFolderStructure。

---

使用说明

1. 确保Excel文件保存为.xlsm格式。
2. 在B1输入基础路径（如D:\FolderFramework）。
3. 在B2及以下输入季度名称（如2025Q1、2025Q2）。
4. 在B6及以下输入子文件夹结构（如私募产品\基金A、公募产品\基金S）。
5. 点击“生成文件夹”按钮运行宏。
6. 宏会检查路径是否存在，若不存在则创建，然后为每个季度生成文件夹和子文件夹结构。

---

注意事项

1. 路径合法性：确保B1中的路径有效，且磁盘有足够权限。
2. 季度和子文件夹输入：确保B列中没有多余空行，否则可能导致循环错误。
3. 错误处理：代码包含基本错误检查，但建议在实际使用前测试。
4. 扩展性：可根据需要修改子文件夹结构（例如添加更多层级或动态读取）。