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