View Full Version : [SOLVED:] Copy complete folder to another folder
mohanraj.610
06-07-2016, 05:00 AM
I need to move all the folders and it contents to a new folder. Folder names are given as in Source folder Column A and the Destination folder is B.
New folder needs to be created if destination doesn't exist. Someone help me out.
Source Folder
Dest
a
xx
a1
xx
b1
xx
c1
xx
a2
yy
a3
yy
mdmackillop
06-07-2016, 02:31 PM
http://www.rondebruin.nl/win/s3/win026.htm
Leith Ross
06-07-2016, 05:54 PM
Hello mohanraj.610,
This code will do what you want. It Starts with cell A2 on the Active Sheet. You can change this to any cell you want for your starting cell.
The macro does not overwrite the files in the destination automatically. It will ask you if you want to or not. Let me know if you want this changed to do that.
Sub CopyFolders()
Dim Cell As Range
Dim DstFolder As Variant
Dim RngBeg As Range
Dim RngEnd As Range
Dim SrcFolder As Variant
Dim Wks As Worksheet
Set Wks = ActiveSheet
Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
With CreateObject("Shell.Application")
For Each Cell In Wks.Range(RngBeg, RngEnd)
SrcFolder = Cell
SrcFolder = IIf(Right(SrcFolder, 1) <> "\", SrcFolder & "\", SrcFolder)
Set SrcFolder = .Namespace(SrcFolder)
DstFolder = Cell.Offset(0, 1)
DstFolder = IIf(Right(DstFolder, 1) <> "\", DstFolder & "\", DstFolder)
If .Namespace(DstFolder) Is Nothing Then MkDir DstFolder
Set DstFolder = .Namespace(DstFolder)
DstFolder.CopyHere SrcFolder, 76
Next Cell
End With
End Sub
mohanraj.610
06-07-2016, 09:29 PM
Hi mdmackillop and Leith,
Thanks for the response.
I have attached the layout for clear view.
I have list of folder that has to be copied with a different names and all the contents in folder needs to be completely copied/moved. New folder needs to be created and moved if folder doesn't exist.
Leith Ross
06-08-2016, 09:48 AM
Hello mohanraj.610,
Here is the updated macro code.
Sub CopyFolders()
Dim Cell As Range
Dim DstFolder As Variant
Dim DstPath As Variant
Dim RngBeg As Range
Dim RngEnd As Range
Dim SrcFolder As Variant
Dim SrcPath As Variant
Dim Wks As Worksheet
Set Wks = ActiveSheet
SrcPath = Wks.Range("B3")
SrcPath = IIf(Right(SrcPath, 1) <> "\", SrcPath & "\", SrcPath)
DstPath = Wks.Range("D3")
DstPath = IIf(Right(DstPath, 1) <> "\", DstPath & "\", DstPath)
Set RngBeg = Wks.Range("B6")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
With CreateObject("Shell.Application")
For Each Cell In Wks.Range(RngBeg, RngEnd)
SrcFolder = SrcPath & Cell
Set SrcFolder = .Namespace(SrcFolder)
DstFolder = DstPath & Cell.Offset(0, 2)
If .Namespace(DstFolder) Is Nothing Then MkDir DstFolder
Set DstFolder = .Namespace(DstFolder)
DstFolder.CopyHere SrcFolder, 76
Next Cell
End With
End Sub
Sub M_snb()
CreateObject("scripting.filesystemobject").MoveFolder "G:\OF\__tst", "G:\__tst"
End Sub
Paul_Hossler
06-08-2016, 07:16 PM
I need to move all the folders and it contents to a new folder. Folder names are given as in Source folder Column A and the Destination folder is B.
New folder needs to be created if destination doesn't exist. Someone help me out.
I'm confused -- do you want to COPY the folders or MOVE the folders?
mohanraj.610
06-08-2016, 09:38 PM
Hi Leith,
Macro is working fine. Thank you!!!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.