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

当需要创建大量文件夹及文件时，可借助excel vba 实现，如下图：

 批量创建文件名为1-10的文件夹，每个文件夹内有个与文件名相同的txt文件，txt文件内的数字也跟文件名相同。

 

 

附代码：

Sub CreateFoldersAndFiles()


    Dim i As Integer
    Dim folderPath As String
    Dim filePath As String
    Dim textFile As Integer
    
    ' 获取当前Excel文件所在的文件夹路径
    folderPath = ThisWorkbook.Path & "\"
    
    ' 循环创建10个文件夹和txt文件
    For i = 1 To 10
        ' 创建文件夹
        MkDir folderPath & i
        
        ' 生成txt文件路径
        filePath = folderPath & i & "\" & i & ".txt"
        
        ' 创建并写入txt文件
        textFile = FreeFile
        Open filePath For Output As textFile
        Print #textFile, i
        Close textFile
    Next i
    
    MsgBox "文件夹和文件创建完成！" 
End Sub

aaa

Sub RenameFilesInSubfolders()
'qq443440204版权所有
    Dim folderPath As String
    Dim subFolder As Object
    Dim file As Object
    Dim newFileName As String
    Dim fileExtension As String
    Dim fs As Object
  On Error Resume Next
    ' 设置主文件夹路径
    folderPath = "D:\xxx\" ' 请将此路径替换为你的实际路径
  
    ' 创建FileSystemObject
    Set fs = CreateObject("Scripting.FileSystemObject")
  
    ' 获取主文件夹对象
    Set mainFolder = fs.GetFolder(folderPath)
  
    ' 遍历主文件夹下的所有子文件夹
    For Each subFolder In mainFolder.SubFolders
        ' 遍历子文件夹下的所有文件
        For Each file In subFolder.Files
            ' 获取文件扩展名
            fileExtension = fs.GetExtensionName(file.Path)
              
            ' 构建新的文件名（子文件夹名称 + 文件扩展名）
            newFileName = subFolder.Name & "." & fileExtension
              
            ' 生成新的文件路径
            newFilePath = fs.BuildPath(subFolder.Path, newFileName)
              
            ' 重命名文件
            Name file.Path As newFilePath
        Next file
    Next subFolder
  
    ' 清理对象
    Set fs = Nothing
    Set mainFolder = Nothing
  
    MsgBox "文件重命名完成！443440204"
End Sub

 

代码代写，可点击下方联系 ↓