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

我已经编写了下面的脚本，它在给定的位置创建一个文件夹（如果该文件夹不存在并以工作簿中的单元格命名）。将所有excel文件从一个位置复制到另一个位置

昏暗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

我现在想所有.XLSM文件sSourcePath复制到新创建的位置fldrpath & \ fldrname但所有尝试都失败了。我对VBA还是比较新的，所以任何帮助将不胜感激。我听说过.copyfile，但我不确定如何在这个例子中使用它。预先感谢您。

来源

2016-08-21 Paul

失败的尝试在哪里？如果您想使用'.CopyFile'方法，您需要创建一个'FileSystemObject'，然后从中调用该方法。它需要通配符，所以它应该为你做这项工作。看起来你已经拥有了一切 - 除了阅读手册'object.CopyFile（source，destination [，overwrite]）' – dbmitch

你只有一个'If'语句，但是你有两个'End If'语句。这个问题是否是一个错字，或者它在你的代码中真的是这样吗？ – YowE3K

我对这项

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

来源

2016-08-21 17:15:10 hstdggsdtgsdafssarf456

我这样做没有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

来源

2016-08-22 02:25:59 PaichengWu

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

回答

相关问题