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
  • ✅ 复制前检查源文件夹是否存在

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

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

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

相关推荐
原则猫35 分钟前
UDP 到底怎么实现可靠的
前端
Java后端的Ai之路39 分钟前
14、ReactJS - 路由(Router)
前端·react.js·状态模式
裕晟资质规划2 小时前
三类涉密资质延续时限差异分析:军工60日与集成印制3个月的边界
java·服务器·前端·网络·安全
ShineWinsu2 小时前
对于JavaScript:JavaScript基础语法的解析
开发语言·前端·javascript·面试·web·基础语法·循环
月夏2 小时前
Vue3 转 React:18 项对照表 + 5 个必踩的坑(附 7 天上手路线)
前端
广州华水科技2 小时前
单北斗GNSS位移监测系统的应用与维护解析
前端
梦曦i3 小时前
uni-storage 0.1.0 发布:TTL过期管理+多实例隔离
前端·storage·uni-app x
猫头_4 小时前
AI 流式传输工程指南:模型吐出半截 JSON,前端如何边收边渲染?
前端·javascript·llm
console.log('npc')4 小时前
第 1 章 项目概述与环境搭建
前端·人工智能·大模型
定栓4 小时前
Webpack迁到Vite第七节(二):全家桶移除 — Babel 全家桶深度分析
前端·webpack·node.js