excel VBA根据excel列值 拷贝文件并修改文件名

Sub fsg()
Dim MyArray1() As String
Dim MyArray2() As String
Dim iNum As Integer
'获取当前列长度
iNum = ActiveSheet.[A65536].End(xlUp).Row
MsgBox iNum
ReDim Preserve MyArray1(iNum) As String
ReDim Preserve MyArray2(iNum) As String
For i = 1 To iNum
'将A列的 Ai值赋值给数组
MyArray1(i - 1) = ActiveSheet.Range("A" & i).Value
MyArray2(i - 1) = ActiveSheet.Range("C" & i).Value
Next i
'MsgBox MyArray1(11)
'MsgBox MyArray2(11)
Dim copyPath1 As String
Dim copyPath2 As String
copyPath1 = "C:\Users\hqy\Desktop\large\"
copyPath2 = "C:\Users\hqy\Desktop\large1\"
Dim name1 As String
Dim name2 As String
Dim changeName As String
'声明检查文件是否存在
Set fso = CreateObject("Scripting.Filesystemobject")
For i = 1 To iNum
'链接字符串
name1 = copyPath1 & MyArray2(i - 1) & ".png"
name2 = copyPath2 & MyArray2(i - 1) & ".png"
changeName = copyPath2 & MyArray1(i - 1) & ".png"
'检查文件是否存在
If fso.FileExists(name1) Then
'文件拷贝 从什么目录到什么目录
FileCopy name1, name2
'修改文件名称
Name name2 As changeName
Else
'文件不存在 修改 excel标示
ActiveSheet.Range("D" & i).Value = 0
End If
Next i
End Sub