ある場所から別の場所にすべてのExcelファイルをコピーする

Question

ブックが存在しない場合は、指定された場所にフォルダを作成する以下のスクリプトを書いています。私は今、すべての試みが失敗し、まだfldrname \新しく作成された場所fldrpath &にsSourcePath内のすべての.xlsmファイルをコピーしようとしているオブジェクト

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 

として

薄暗いFSO。私はまだ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