批量创建文件夹和文件——excel VBA实现

当必要创建大量文件夹及文件时，可借助excel vba 实现，如下图：
 批量创建文件名为1-10的文件夹，每个文件夹内有个与文件名类似的txt文件，txt文件内的数字也跟文件名类似。

 

 

附代码：

2. Sub CreateFoldersAndFiles()
4.     Dim i As Integer
5.     Dim folderPath As String
6.     Dim filePath As String
7.     Dim textFile As Integer
8.    
9.     ' 获取当前Excel文件所在的文件夹路径
10.     folderPath = ThisWorkbook.Path & ""
11.    
12.     ' 循环创建10个文件夹和txt文件
13.     For i = 1 To 10
14.         ' 创建文件夹
15.         MkDir folderPath & i
16.         
17.         ' 生成txt文件路径
18.         filePath = folderPath & i & "" & i & ".txt"
19.         
20.         ' 创建并写入txt文件
21.         textFile = FreeFile
22.         Open filePath For Output As textFile
23.         Print #textFile, i
24.         Close textFile
25.     Next i
26.    
27.     MsgBox "文件夹和文件创建完成！"
28. End Sub

复制代码

aaa

2. Sub RenameFilesInSubfolders()
3. 'qq443440204版权所有
4.     Dim folderPath As String
5.     Dim subFolder As Object
6.     Dim file As Object
7.     Dim newFileName As String
8.     Dim fileExtension As String
9.     Dim fs As Object
10.   On Error Resume Next
11.     ' 设置主文件夹路径
12.     folderPath = "D:\xxx" ' 请将此路径替换为你的实际路径
13.   
14.     ' 创建FileSystemObject
15.     Set fs = CreateObject("Scripting.FileSystemObject")
16.   
17.     ' 获取主文件夹对象
18.     Set mainFolder = fs.GetFolder(folderPath)
19.   
20.     ' 遍历主文件夹下的所有子文件夹
21.     For Each subFolder In mainFolder.SubFolders
22.         ' 遍历子文件夹下的所有文件
23.         For Each file In subFolder.Files
24.             ' 获取文件扩展名
25.             fileExtension = fs.GetExtensionName(file.Path)
26.               
27.             ' 构建新的文件名（子文件夹名称 + 文件扩展名）
28.             newFileName = subFolder.Name & "." & fileExtension
29.               
30.             ' 生成新的文件路径
31.             newFilePath = fs.BuildPath(subFolder.Path, newFileName)
32.               
33.             ' 重命名文件
34.             Name file.Path As newFilePath
35.         Next file
36.     Next subFolder
37.   
38.     ' 清理对象
39.     Set fs = Nothing
40.     Set mainFolder = Nothing
41.   
42.     MsgBox "文件重命名完成！443440204"
43. End Sub

复制代码

 
代码代写，可点击下方接洽 ↓