批量复制文件并改名

Sub 批量复制文件并改名() '变量声明
Dim sPathOld As String '源文件夹路径
Dim sPathNew As String '目标文件夹路径
Dim sFileNameOld As String '旧文件名
Dim sFileNameNew As String '新文件名
'获取源文件夹路径
sPathOld = ThisWorkbook.Path & "\文件\"
'获取目标文件夹路径
sPathNew = ThisWorkbook.Path & "\新文件\"
'查找源文件夹中的文件
sFileNameOld = Dir(sPathOld & "*")
'当查找结果存在时不断循环
Do While sFileNameOld <>""
'设定新文件名
sFileNameNew = sFileNameOld & ".BAK"
'复制文件并改名
FileCopy sPathOld & sFileNameOld, sPathNew & sFileNameNew
'移动文件
'Name sPathOld & sFileNameold As sPathNew & sFileNamenew
'查找下一个文件
sFileNameOld = Dir
Loop
End Sub