Moving folders to another directory

Question

I recently posted a question here about moving files to another directory (Moving files to another directory), now I want to move folders, which will then be archived.

The layout is the same with the existing folder in A, target in B and a column C to confirm if completed.

Code provided was

Sub move_files()
    Dim i As Long
    With ActiveSheet
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Err.Clear
            On Error Resume Next
            Name (.Cells(i, 1)) As .Cells(i, 2) & "\" & StrReverse(Split(StrReverse(.Cells(i, 1)), "\")(0))
            If Err = 0 Then .Cells(i, 3) = "YES" Else .Cells(i, 3) = "NO"
            On Error GoTo 0
        Next
    End With
End Sub

Given I am trying to move an entire column, does anyone know if the above can be adapted to move the folder as it only currently works for files. I have searched online but is usually only for one file.

Did you do any research? I mean if you google for *"vba move folder"* you find tons of examples how to move complete folders. Also there is the [MoveFolder method](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/movefolder-method) in the [FileSystemObject object](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object). Read them carefully and give it a try yourself. If you get stuck or errors show the code you have tried. Otherwise this is just asking us to do the work for you. — Pᴇʜ, Mar 10 '20 at 07:47
Far too much, there are ones that can move folders, but not so much from a list and have to specify paths, so not good for thousands of files. Also none I could see showing error reporting. — Scottyp, Mar 10 '20 at 13:25

ZygD · Accepted Answer · 2020-03-10T08:41:29.197

1

This is a revised version moving folders only. Hopefully it will work.

Sub move_folders()
  Dim i As Long
  Dim oFSO As Object
  Dim sep As String

  Set oFSO = CreateObject("Scripting.FileSystemObject")
  With ActiveSheet
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
      Err.Clear
      If Left(StrReverse(.Cells(i, 2)), 1) = "\" Then sep = "" Else sep = "\"
      On Error Resume Next
      oFSO.MoveFolder .Cells(i, 1), .Cells(i, 2) & sep & StrReverse(Split(StrReverse(.Cells(i, 1)), "\")(0))
      If Err = 0 Then .Cells(i, 3) = "YES" Else .Cells(i, 3) = "NO"
      On Error GoTo 0
    Next
  End With
End Sub

edited Mar 10 '20 at 08:41

answered Mar 10 '20 at 08:35

ZygD

22,092
39
79
102

man that was quick thankyou! I don't quite understand the FSO part but will do some more reading over the weekend and see if I can figure it out. Thanks a bunch Scott – Scottyp Mar 11 '20 at 01:36

Moving folders to another directory

1 Answers1