将所有excel文件从一个位置复制到另一个位置

我已经写了下面的脚本，它在给定的位置创build一个文件夹（如果它不存在，它以工作簿中的单元格命名）。

昏暗的fso作为对象

Dim fldrname As String Dim fldrpath As String Dim sFileType As String Dim sSourcePath As String Dim Destination As String Set fso = CreateObject("scripting.filesystemobject") sSourcePath = "\\INSURANCE\IT\FileData\Computers\DIPS\" fldrname = Worksheets("Applications").Range("A2").Value fldrpath = "\\INSURANCE\IT\FileData\Computers\DIPS\DIP Archive\" & fldrname If Not fso.folderexists(fldrpath) Then fso.createfolder (fldrpath) End If End If 

我现在试图将sSourcePath中的所有.xlsm文件复制到新创build的位置fldrpath＆\ fldrname，但所有尝试失败。 我还是相当新的VBA所以任何帮助，将不胜感激。 我听说.copyfile，但我不知道如何利用这个例子。 先谢谢你。

Answer 1

我承担这一点

 Sub copyFiles() Dim fldrname As String, fldrpath As String, sFileType As String Dim sSourcePath As String, Destination As String Dim fso As Object, fFolder As Object, fFile As Object Set fso = CreateObject("scripting.filesystemobject") sSourcePath = "\\SourcePath" '"\\INSURANCE\IT\FileData\Computers\DIPS\" fldrname = "data\" 'Worksheets("Applications").Range("A2").Value fldrpath = "\\SourcePath\Archive\" & fldrname '"\\INSURANCE\IT\FileData\Computers\DIPS\DIP Archive\" & fldrname If Not fso.folderexists(fldrpath) Then fso.createfolder (fldrpath) End If Set fFolder = fso.GetFolder(sSourcePath) For Each fFile In fFolder.Files 'If Not (fso.FileExists(fldrpath & fFile.Name)) Then fFile.Copy fldrpath, Overwritefiles:=False fFile.Copy fldrpath, Overwritefiles:=True Next fFile End Sub 

Answer 2

我这样做没有filesystemobject 。

 Sub copyfiles() Dim source_file As String, dest_file As String Dim source_path As String, dest_path As String Dim i As Long, file_array As Variant source_path = "\\INSURANCE\IT\FileData\Computers\DIPS" dest_path = "\\INSURANCE\IT\FileData\Computers\DIPS\DIP Archive" source_file = Dir(source_path & "\" & "*.xlsm") Do Until source_file = "" If Not IsArray(file_array) Then ReDim file_array(0) As Variant Else ReDim Preserve file_array(UBound(file_array) + 1) As Variant End If file_array(UBound(file_array)) = source_file source_file = Dir Loop 'If new folder is not existed, create it. If Dir(dest_path, 16) = "" Then MkDir dest_path '16=vbDirectory For i = LBound(file_array) To UBound(file_array) FileCopy source_path & "\" & file_array(i), dest_path & "\" & file_array(i) Next i End Sub