PDA

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

snb
06-08-2016, 12:38 PM
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!!!