Xin giúp đỡ code VBA copy các thư mục nhỏ trong 1 thư mục sang thư mục khác

Chia sẻ bởi:hands

★★★★★

‹ XEM GIÚP EM ĐOẠN CODE ẨN CỘT... Tìm Hàm ngược với Hàm RAND ›

Quảng cáo

Mong mọi người giúp đỡ ạ!
Em muốn tìm code VBA giúp copy các thư mục nhỏ trong 1 thư mục tổng rồi sao chép qua 1 thư mục khác ạ.

6602

Sub CopyFolderContents()

Dim SourceFolder As String
    Dim DestinationFolder As String

SourceFolder = [B]Range("A1").Value[/B]
    DestinationFolder = [B]Range("A2").Value[/B]

Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objSourceFolder = objFSO.GetFolder(SourceFolder)
    Set objDestinationFolder = objFSO.GetFolder(DestinationFolder)

For Each objFile In objSourceFolder.Files
        objFile.Copy objDestinationFolder & "" & objFile.Name, True
    Next objFile

For Each objSubFolder In objSourceFolder.SubFolders
        objFSO.CreateFolder objDestinationFolder & "" & objSubFolder.Name
        CopyFolderContentsRecursively objSubFolder.Path, objDestinationFolder & "" & objSubFolder.Name
    Next objSubFolder

MsgBox "Folder contents have been copied successfully!"

End Sub

Sub CopyFolderContentsRecursively(sSourcePath As String, sTargetPath As String)

Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objSourceFolder = objFSO.GetFolder(sSourcePath)
    Set objTargetFolder = objFSO.GetFolder(sTargetPath)

For Each objFile In objSourceFolder.Files
        objFile.Copy objTargetFolder & "" & objFile.Name, True
    Next objFile

For Each objSubFolder In objSourceFolder.SubFolders
        objFSO.CreateFolder objTargetFolder & "" & objSubFolder.Name
        CopyFolderContentsRecursively objSubFolder.Path, objTargetFolder & "" & objSubFolder.Name
    Next objSubFolder

End Sub

Thử code trên nhé bạn, link folder cần copy ở ô A1, link folder cần copy qua ở ô A2

www.giaiphapexcel.com/diendan/threads/xin-gi%C3%BAp-%C4%91%E1%BB%A1-code-vba-copy-c%C3%A1c-th%C6%B0-m%E1%BB%A5c-nh%E1%BB%8F-trong-1-th%C6%B0-m%E1%BB%A5c-sang-th%C6%B0-m%E1%BB%A5c-kh%C3%A1c.165268/