利用VBA实现高效批量创建文件夹与智能归类文件

实际需求

在审计工作中，每个会计科目的实质性底稿通常是以独立的Excel文件存在。为了提升文件管理的规范性，我们可能需要给每个实质性底稿建立对应的文件夹。此时，如果我们使用手动方式逐个创建文件夹与移动文件，这不仅效率低下，而且容易出错。

解决方案

为了实现高效批量创建文件夹与智能归类文件，我们可以利用VBA代码，实现以下功能：在指定的文件夹路径下为每个文件创建一个与文件同名的文件夹，同时将文件移动到对应的文件夹里。

Sub CreateFoldersAndMoveFiles()   Dim folderPath As String   Dim fso As Object   Dim folder As Object   Dim file As Object   Dim newFolderPath As String   Dim fileName As String

  ' 设置文件夹路径（请修改为你需要的路径）   folderPath = "C:\Users\VBAMatrix\Desktop\实质性底稿\"

  ' 检查路径是否以反斜杠结尾，如果没有则添加   If Right(folderPath, 1) <> "\" Then       folderPath = folderPath & "\"   End If

  ' 创建文件系统对象   Set fso = CreateObject("Scripting.FileSystemObject")

  ' 检查文件夹是否存在   If Not fso.FolderExists(folderPath) Then       MsgBox "指定的文件夹路径不存在！", vbExclamation       Exit Sub   End If

  ' 获取文件夹对象   Set folder = fso.GetFolder(folderPath)

  ' 遍历文件夹中的每个文件   For Each file In folder.Files       ' 获取文件名（不含扩展名）       fileName = fso.GetBaseName(file.Name)

      ' 构建新文件夹路径       newFolderPath = folderPath & fileName

      ' 检查文件夹是否已存在，不存在则创建       If Not fso.FolderExists(newFolderPath) Then           fso.CreateFolder newFolderPath           Debug.Print "已创建文件夹: " & newFolderPath       End If

      ' 移动文件到对应的文件夹       On Error Resume Next ' 防止因权限等问题导致的错误       fso.MoveFile file.Path, newFolderPath & "\" & file.Name       If Err.Number = 0 Then           Debug.Print "已移动文件: " & file.Name & " 到 " & newFolderPath       Else           Debug.Print "移动文件失败: " & file.Name & " 错误: " & Err.Description           Err.Clear       End If       On Error GoTo 0   Next file

  ' 清理对象   Set file = Nothing   Set folder = Nothing   Set fso = Nothing

  MsgBox "操作完成！", vbInformationEnd Sub

演示视频

如果你不熟悉VBA代码也没关系，“Excel矩阵”插件提供了更便捷的解决方案。

Excel矩阵介绍

作为一款功能全面、操作简单的Excel办公自动化工具，"Excel矩阵"集成了近百个实用功能，例如批量替换链接、合并拆分工作簿、制作二维码/条形码、随机生成百万条信息（姓名、电话、地址等）…

同时，接入了DeepSeek，支持官网、火山引擎、硅基流动等多种接入方式，轻松实现生成数据分析报告、自定义数据可视化动态面板、制作多种炫酷图表…

Excel矩阵功能区

目前已有超过1,000名用户下载使用，获得广大使用群体的一致好评。

>>推荐阅读<<

★★★查看更多的内容★★★