[已解决]如何批量复制文件？

飞云流水

比如C:\Sin  文件夹内有30个excel文件，批量复制到D:\备份  文件夹内，文件较多如何写代码！

最佳答案

月排行榜 / 总排行榜

wayy

2011-12-22 08:07

飞云流水 发表于 2011-12-21 17:02
老师你看看，我调试不了

备份.rar (97.54 KB, 下载次数: 38)

2011-12-22 08:07 上传

点击文件名下载附件 　　

试一下吧。

跳转到最佳答案楼层

wayy

1. Sub CopyFile()
   
2. Dim strSfile As String
   
3. Dim strDfile As String
   
4. 
   
5. strSfile = ThisWorkbook.Path & "\Temp.xls"
   
6. strDfile = ThisWorkbook.Path & "\Temp\Temp.xls"
   
7. 
   
8. FileCopy strSfile, strDfile
   
9. End Sub
   

复制代码

2）、FileSystemObject对象：CopyFile

1. Sub CopyFile_fso()
   
2. Dim strSfile As String
   
3. Dim strDfile As String
   
4. Dim fso As New FileSystemObject
   
5. 
   
6. strSfile = ThisWorkbook.Path & "\Temp.xls"
   
7. strDfile = ThisWorkbook.Path & "\Temp\Temp.xls"
   
8. fso.CopyFile strSfile, strDfile
   
9. 
   
10. Set fso = Nothing
    
11. End Sub
    

复制代码

飞云流水

wayy 发表于 2011-12-21 15:41
2）、FileSystemObject对象：CopyFile

这只能复制一个文件，其它29个文件名不一样需要都添加，要批量能复制，不用每个文件名都加到代码里

wayy

1. Sub 复制文件()
   
2. Dim dirname, path1, path2 As String
   
3. path1 = ThisWorkbook.Path & "\TEMP"
   
4. path2 = ThisWorkbook.Path & "\BF"
   
5. dirname = Dir(path1 & "*.xls")
   
6. Do While dirname <> ""
   
7.   FileCopy path1 & dirname, path2 & dirname
   
8.   dirname = Dir
   
9. Loop
   
10. MsgBox "文件备份完毕！！", , "wayy提示您"
    
11. End Sub
    

复制代码

参照楼下附件改的代码。

飞云流水

wayy 发表于 2011-12-21 16:38

老师你看看，我调试不了

wayy

飞云流水 发表于 2011-12-21 17:02
老师你看看，我调试不了

备份.rar (97.54 KB, 下载次数: 38)

2011-12-22 08:07 上传

点击文件名下载附件 　　

试一下吧。

飞云流水

wayy 发表于 2011-12-22 08:07
　　

试一下吧。

谢谢！可以了！以后要多学习了