如何用R或Excel批量提取指定类型文件并按原文件夹分类迁移

R 实现方案 #

使用fs包可以高效处理文件系统操作，步骤如下：

1. 安装并加载依赖包

install.packages("fs")
library(fs)

2. 配置核心参数
   替换以下路径和分类规则为你的实际需求：

# 原混乱目录的路径
source_dir <- "~/你的原目录路径"
# 定义分类映射：目标文件夹名 -> 对应文件后缀
category_map <- list(
  "ImageFolder" = c(".jpg", ".png"),
  "ReportFolder" = c(".pdf")
)

3. 执行文件迁移
   这段代码会遍历原目录的一级子文件夹，按规则创建目标目录并迁移文件：

# 获取原目录下的所有一级子文件夹
subfolders <- dir_ls(source_dir, type = "directory", recursive = FALSE)

for (subfolder in subfolders) {
  # 提取子文件夹名称
  subfolder_name <- path_file(subfolder)
  
  # 遍历每个分类规则
  for (target_folder in names(category_map)) {
    # 构建目标子文件夹路径
    target_subdir <- path(target_folder, subfolder_name)
    # 自动创建不存在的目录
    dir_create(target_subdir, recursive = TRUE)
    
    # 筛选当前子文件夹中符合类型的文件
    target_files <- dir_ls(subfolder, regexp = paste0(category_map[[target_folder]], collapse = "|"), ignore.case = TRUE)
    
    # 移动文件（如需复制，替换为file_copy）
    file_move(target_files, target_subdir)
  }
}

注意事项：

• 若要处理嵌套子文件夹，将recursive = FALSE改为TRUE
• ignore.case = TRUE确保不区分文件后缀大小写（如.JPG也会被识别）

Excel VBA 实现方案 #

如果更熟悉Excel，可通过VBA直接操作文件系统：

1. 打开Excel，按Alt+F11进入VBA编辑器
2. 右键点击当前工作簿 -> 插入 -> 模块
3. 粘贴以下代码：

Sub OrganizeFilesByType()
    Dim sourceDir As String
    Dim targetMap As Object
    Dim subFolders As Collection
    Dim subFolder As Variant
    Dim targetFolder As Variant
    Dim fileExts As Variant
    Dim fileName As String
    Dim targetSubDir As String
    
    ' 替换为你的原目录路径
    sourceDir = "C:\你的原混乱目录路径\"
    ' 配置分类规则
    Set targetMap = CreateObject("Scripting.Dictionary")
    targetMap("ImageFolder") = Array(".jpg", ".png")
    targetMap("ReportFolder") = Array(".pdf")
    
    ' 收集原目录下的一级子文件夹
    Set subFolders = New Collection
    fileName = Dir(sourceDir, vbDirectory)
    Do While fileName <> ""
        If fileName <> "." And fileName <> ".." Then
            If (GetAttr(sourceDir & fileName) And vbDirectory) = vbDirectory Then
                subFolders.Add sourceDir & fileName & "\"
            End If
        End If
        fileName = Dir
    Loop
    
    ' 遍历子文件夹并处理文件
    For Each subFolder In subFolders
        ' 提取子文件夹名称
        Dim subFolderName As String
        subFolderName = Mid(subFolder, InStrRev(subFolder, "\", -2) + 1)
        subFolderName = Left(subFolderName, Len(subFolderName) - 1)
        
        ' 按分类处理文件
        For Each targetFolder In targetMap.Keys
            fileExts = targetMap(targetFolder)
            ' 创建目标子目录
            targetSubDir = ThisWorkbook.Path & "\" & targetFolder & "\" & subFolderName & "\"
            If Dir(targetSubDir, vbDirectory) = "" Then
                MkDir targetSubDir
            End If
            
            ' 复制（或移动）对应文件
            For Each ext In fileExts
                fileName = Dir(subFolder & "*" & ext, vbNormal)
                Do While fileName <> ""
                    FileCopy subFolder & fileName, targetSubDir & fileName
                    ' 如需删除原文件（即移动），取消下面一行的注释
                    ' Kill subFolder & fileName
                    fileName = Dir
                Loop
            Next ext
        Next targetFolder
    Next subFolder
    
    MsgBox "文件整理完成！"
End Sub

注意事项：

• 替换sourceDir为你的原目录路径
• 目标目录默认创建在当前Excel文件所在文件夹，可修改targetSubDir调整路径
• 默认是复制文件，若要移动文件，取消Kill subFolder & fileName的注释

内容的提问来源于stack exchange，提问作者Gator