VBA使用FSO执行CopyFile无法显示复制进度窗口及相关报错求助

问题原因排查 #

• 运行时错误424（对象所需）原因：Scripting.FileSystemObject的CopyFile方法本身不支持调用系统内置复制UI，你代码中用到的FileIO.UIOption.AllDialogs是.NET框架专属的枚举值，VBA运行环境不存在该对象，因此触发对象缺失报错。
• 编译错误Expected: =原因：这是VBA基础语法规则，调用无返回值的方法时，要么省略参数外侧的括号，要么在方法前添加Call关键字。你直接给CopyFile的参数加括号、又没有变量接收返回值，就会触发该编译错误，符合规则的写法如下：

' 写法1：不使用Call关键字，省略参数括号
FSO.CopyFile fi.Path, fi.ParentFolder.Path & "\NeuerOrdner\", True
' 写法2：使用Call关键字，参数可加括号
Call FSO.CopyFile(fi.Path, fi.ParentFolder.Path & "\NeuerOrdner\", True)

• 无法调出系统复制进度窗口的核心原因：FileSystemObject组件的定位是后台无UI的文件操作接口，原生没有调用系统复制UI的能力，需要改用Shell.Application对象实现该需求。

正确实现方案（可调用系统原生复制进度窗口） #

使用Shell.Application的CopyHere方法即可自动唤起系统内置的复制对话框，自带进度显示、文件冲突提示等原生交互，可运行代码如下：

Sub CopyWithSystemProgressUI()
    Dim shellApp As Object
    Dim sourceFile As String
    Dim targetFolder As String
    Dim FSO As Object
    Dim fo As Object, fi As Object, foi As Object
    Dim testfs As String
    
    ' 初始化所需对象
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set shellApp = CreateObject("Shell.Application")
    
    ' 沿用原有逻辑获取待复制的文件
    Set fo = FSO.GetFolder("C:\Users\Peer\Desktop\Cache\vba\NeuerOrdner\")
    For Each foi In fo.Files
        Debug.Print foi.Name
        testfs = foi.Name
    Next foi
    Set fi = FSO.GetFile(fo.Path & "\" & testfs)
    
    ' 配置源文件路径、目标文件夹路径
    sourceFile = fi.Path
    targetFolder = fi.ParentFolder.Path & "\NeuerOrdner\"
    
    ' 目标文件夹不存在时先创建，避免报错
    If Not FSO.FolderExists(targetFolder) Then
        FSO.CreateFolder targetFolder
    End If
    
    ' 调用系统原生复制UI，&H4&参数指定显示复制进度对话框
    shellApp.Namespace(CVar(targetFolder)).CopyHere CVar(sourceFile), &H4&
End Sub

如果需要自定义复制行为，可调整CopyHere的第二个参数：比如添加&H10&可跳过覆盖确认弹窗，组合使用时参数写为&H4& + &H10&即可。

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