vba将一个文件夹的内容复制到另外一个文件夹的函数,若存在则是否覆盖的参数。复制前检查源文件夹是否存在。若目标文件夹不存在,则新建

vbnet 复制代码
' ============================================================
' 复制文件夹内容到另一个文件夹
' srcPath  : 源文件夹路径(必须存在)
' dstPath  : 目标文件夹路径(不存在则自动创建)
' overwrite: True = 覆盖同名文件; False = 跳过已存在文件
' 返回值   : True = 成功; False = 失败
' ============================================================
Function CopyFolderContents(ByVal srcPath As String, _
                            ByVal dstPath As String, _
                            ByVal overwrite As Boolean) As Boolean

    Dim fso As Object
    Dim srcFolder As Object
    Dim subFolder As Object
    Dim fileItem As Object
    Dim targetPath As String

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' ---------- 1. 检查源文件夹是否存在 ----------
    If Not fso.FolderExists(srcPath) Then
        MsgBox "源文件夹不存在:" & vbCrLf & srcPath, vbExclamation, "错误"
        CopyFolderContents = False
        Exit Function
    End If

    ' ---------- 2. 目标文件夹不存在则创建 ----------
    If Not fso.FolderExists(dstPath) Then
        On Error GoTo CreateErr
        fso.CreateFolder dstPath
        On Error GoTo 0
    End If

    Set srcFolder = fso.GetFolder(srcPath)

    ' ---------- 3. 复制文件 ----------
    For Each fileItem In srcFolder.Files
        targetPath = fso.BuildPath(dstPath, fileItem.Name)

        If fso.FileExists(targetPath) Then
            ' 文件已存在
            If overwrite Then
                On Error GoTo CopyErr
                fso.CopyFile fileItem.Path, targetPath, True   ' 覆盖
                On Error GoTo 0
            End If
            ' overwrite = False 时直接跳过
        Else
            ' 文件不存在,直接复制
            On Error GoTo CopyErr
            fso.CopyFile fileItem.Path, targetPath, False
            On Error GoTo 0
        End If
    Next fileItem

    ' ---------- 4. 递归复制子文件夹 ----------
    For Each subFolder In srcFolder.SubFolders
        targetPath = fso.BuildPath(dstPath, subFolder.Name)
        If Not CopyFolderContents(subFolder.Path, targetPath, overwrite) Then
            CopyFolderContents = False
            Exit Function
        End If
    Next subFolder

    CopyFolderContents = True
    Exit Function

CreateErr:
    MsgBox "无法创建目标文件夹:" & vbCrLf & dstPath & vbCrLf & Err.Description, vbCritical, "错误"
    CopyFolderContents = False
    Exit Function

CopyErr:
    MsgBox "复制文件失败:" & vbCrLf & fileItem.Path & vbCrLf & Err.Description, vbCritical, "错误"
    CopyFolderContents = False
    Exit Function

End Function
  • ✅ 复制前检查源文件夹是否存在

  • ✅ 目标文件夹不存在则自动创建

  • ✅ 通过参数控制是否覆盖已存在的文件

  • ✅ 支持递归复制子文件夹

相关推荐
风骏时光牛马7 分钟前
生成一个AI转岗经历标题,只需要一个标题,不需要其他的任何文本。
前端
Csvn9 小时前
Monorepo
前端
Csvn9 小时前
流水线
前端
Csvn9 小时前
微前端架构
前端
Linux-lucky11 小时前
45-Linux学习之旅之防火墙与WEB加固
linux·前端·网络·学习·ubuntu
风骏时光牛马13 小时前
生成一个移动端标题,只需要一个标题,不需要其他的任何文本。
前端
IT_陈寒14 小时前
Redis雪崩把我坑惨了,这是5年经验的教训
前端·人工智能·后端
SameX14 小时前
HarmonyOS ArkUI List 的侧滑删除 用 ListItem 的 swipeAction + endIcon 的做法
前端
usdoc文档预览16 小时前
USDOC系列之PPT文件在线编辑-VUE前端实现在线浏览器在线编辑PPT文档
前端·vue.js·编辑器·office365·ppt在线编辑·office文件在线编辑·文件在线编辑
用户27050777252416 小时前
Agent 调工具卡住?3 种超时与取消策略实测对比
前端