將所有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文件從一個位置複製到另一個位置

回答

相關問題