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

[Huyhoangg]

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 ạ.

 

[snow25]

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 ạ.

Vấn đề là trong thư mục đấy có những file nào hay là copy hết.Mà trong thư mục còn có thư mục nhỏ không.Bạn nói chi tiết ra thì mới biết được chứ.

 

[heyhey1994]

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 ạ.

Sub CopyFolderContents()

Dim SourceFolder As String
Dim DestinationFolder As String

SourceFolder = Range("A1").Value
DestinationFolder = Range("A2").Value

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

 

[Huyhoangg]

View attachment 290201

Sub CopyFolderContents()

Dim SourceFolder As String
Dim DestinationFolder As String

SourceFolder = Range("A1").Value
DestinationFolder = Range("A2").Value

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

cảm ơn bạn nha đúng cái mk cần rùi