Move all files on XX Folder to XX Folder based on excel.

[harky]

Hi, i really need some help. I had many folder to move https://www.mrexcel.com/forum/images/smilies/icon_smile.gif

I want to move all inside files inside folder on col A to folder col B

*No overwrite of same filename
*delete empty folder of Col A (NOT COL B)
*New folder will created if destination doesn't exist.





From Folder (Col A)
Source
Move to Folder (Col B)
Destination
Status (Col C)


\\abc\folder1\
\\abc\Main1\
Files Moved / No files in Source Path / Files already exist


\\abc\folder2\
\\abc\Main1\
Moved


\\abc\folder3\
\\abc\Main2\
Moved


\\abc\folder4\
\\abc\Main2\
Moved


\\abc\folder5\
\\abc\Main2\
Moved




If Len(FNames) = 0 Then
Cells(i, 3).Value = "No files in Source Path"
Else
Cells(i, 3).Value = "Files already exist"
End If





Sub Move_Files_To_NewFolder()
'http://www.rondebruin.nl/folder.htm


'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you


Dim FSO As Object
Dim FromPath As String, ToPath As String
Dim FileExt As String, FNames As String
Dim LR As Long, i As Long


LR = Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To LR
FromPath = Range("A" & i).Value
ToPath = Range("B" & i).Value
FileExt = "*.*" '<< Change / You can use *.* for all files or *.doc* for word files
If Right(FromPath, 1) <> "" Then FromPath = FromPath & ""
FNames = Dir(FromPath & FileExt)
If Len(FNames) = 0 Then MsgBox "No files in " & FromPath
Set FSO = CreateObject("scripting.filesystemobject")
FSO.CreateFolder (ToPath)
FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
Next

End Sub

[snb]

You'd better move folders instead of files.

[harky]

The code do what it does, but need some help in enhancement.
I cant move folder as in the end i need to unfold myself.... had thousand of them


You'd better move folders instead of files.

[snb]

If you know better then why asking ?

[harky]

Is there issue or wrong to ask?




If you know better then why asking ?

[Leith Ross]

Hello harky,

This will move files and folders within the parent folder (Column "A") to the destination folder (Column "B"). If you want to only move the files in the parent folder then add the flag FOF_FILESONLY to the flags variable. This will not overwrite files that have the same name but will add and index number like (1) to the file name. If a destination folder does not exist then it will be created. If the parent folder is empty it will be deleted.



Sub MoveFilesAndFolders()


Dim Cell As Range
Dim flags As Long
Dim fldrFrom As Object
Dim fldrTo As Object
Dim objShell As Object
Dim Rng As Range
Dim Wks As Worksheet

' // Folder Operation Flags
Const FOF_MULTIDESTFILES = &H1 ' The pTo member specifies multiple destination files (one for each source file in pFrom) rather than one directory where all source files are to be deposited.
Const FOF_SILENT = &H4 ' don't create progress/report
Const FOF_RENAMEONCOLLISION = &H8 ' Give the file being operated on a new name in a move, copy, or rename operation if a file with the target name already exists at the destination.
Const FOF_NOCONFIRMATION = &H10 ' Respond with Yes to All for any dialog box that is displayed.
Const FOF_ALLOWUNDO = &H40 ' Preserve undo information, if possible. If the source file parameter does not contain fully qualified path and file names, this flag is ignored.
Const FOF_FILESONLY = &H80 ' Perform the operation only on files (not on folders) if a wildcard file name (*.*) is specified.
Const FOF_SIMPLEPROGRESS = &H100 ' Display a progress dialog box but do not show individual file names as they are operated on.
Const FOF_NOCONFIRMMKDIR = &H200 ' Do not ask the user to confirm the creation of a new directory if the operation requires one to be created.

flags = FOF_SILENT Or FOF_RENAMEONCOLLISION Or FOF_NOCONFIRMMKDIR Or FOF_ALLOWUNDO

Set objShell = CreateObject("Shell.Application")

Set Wks = ActiveSheet

Set Rng = Wks.Cells("A1", Wks.Cells(Rows.Count, "A").End(xlUp))

For Each Cell In Rng.Cells
Set fldrFrom = objShell.Namespace(Cell.Value)
Set fldrTo = objShell.Namespace(Cell.Offset(0, 1).Value)
If fldrFrom.Items.Count = 0 Then
RmDir fldrFrom.Self.Path
Else
fldrTo.MoveHere fldrFrom, flags
End If
Next Cell

End Sub