Excel VBA 复制文件宏 运行报错：70之原因-20240614

讨论分享
1

我的其他帖子

1. 是一个什么宏？

我在ChatGPT上生成了一个宏，就是点击后将不同路径的不同excel文件分别覆盖到One drive盘和一个公司的Nas盘上。

2. 报错

生成后使用没问题。过一天后使用发现失败了，显示

运行时错误 70：
拒绝的权限

我检查了一下，我要复制的文件都已经关闭了。所以，当时我就认为是网管把我Ban了，不允许我这么操作，但是我又发现我可以打开网盘。于是，我认为这是代码有误，折腾了一番，结果还是报一样的错。

今天去手动覆盖文件，结果发现也报错了：

发生错误 正在复制xxxx.xlsx:
另一个程序正在使用此文件，进程无法访问。(32)

最后才发现，另外一个同事打开了文件导致了上面的报错。全都关闭后宏就正常了。

3. 宏代码

Sub CopyMultipleFilesAndOverwrite()
    ' 定义源文件和目标文件的路径
    Dim sourceFiles(1 To 4) As String
    Dim destinationFiles(1 To 4, 1 To 2) As String

    ' 源文件路径
    sourceFiles(1) = "D:\xxx\x1.xlsx"
    sourceFiles(2) = "D:\xxx\x2.xlsx"
    sourceFiles(3) = "D:\xxx\x3.xlsx"
    sourceFiles(4) = "D:\xxx\x4.xlsx"

    ' 目标文件路径
    destinationFiles(1, 1) = "S:\xxx\x1.xlsx"
    destinationFiles(1, 2) = "C:\xxx\x1.xlsx"
    
    destinationFiles(2, 1) = "S:\xxx\x2.xlsx"
    destinationFiles(2, 2) = "C:\xxx\x2.xlsx"
    
    destinationFiles(3, 1) = "S:\xxx\x3.xlsx"
    destinationFiles(3, 2) = "C:\xxx\x3.xlsx"
    
    destinationFiles(4, 1) = "S:\xxx\x4.xlsx"
    destinationFiles(4, 2) = "C:\xxx\x4.xlsx"

    ' 使用FileSystemObject进行文件复制并选择覆盖
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To 4
        ' 检查源文件是否存在
        If fso.FileExists(sourceFiles(i)) Then
            For j = 1 To 2
                ' 复制并覆盖目标文件
                fso.CopyFile sourceFiles(i), destinationFiles(i, j), True
            Next j
        Else
            MsgBox "源文件 '" & sourceFiles(i) & "' 不存在，请检查路径。"
        End If
    Next i

    ' 清理对象
    Set fso = Nothing
    MsgBox "完成"
End Sub