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

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