Search for a partial folder name within a group of subfolders, move the folder and it's contents to a destination folder

Important Notice

Please note that on 14th December 2023 users will experience an expected outage whilst we make upgrades to our network. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.

  • Hi Roy,

    it still says folder does not exist. Prior to updating the line I included test after the reference number in cell A2 and it copied over the contents of the folder but not the folder itself.

    The new code you have gave me does neither.

    Cell C2 pulls in the surname from the tracker spreadsheet based on the number in A2 if that's any help?



  • Hi Roy,

    I have it working and from the last line of code you gave. I have created a formula to generate the surname, which seems to work.

    FromPath = "\\DFW03018\Data_DFZ70069\199711009\workgroup\DATA_MAN\shared\RAR WoH\" & "DPR " & Worksheets("Interface").Range("A2").Value & " " & Worksheets("Interface").Range("G18").Value

    G18 is where I have the surname, that uses cell A2 to pull the surname from the tracker into G18 when cell A2 is populated.

    The problem I have now is that it is copying the contents of the case folder and not the case folder itself.

    I would also like the case moved, or alternatevely copied and deleted from it's original location.



  • Hi Roy,

    I have done it.

    I used this script to obtain the folder name

    Sub GetSubFolderNames()

    Dim FileName As String

    Dim PathName As String



    ROW = 1

    PathName = "C:\Users\Lee Lowes\Music\Source\"

    FileName = Dir(PathName, vbDirectory)

    Do While FileName <> ""

    If GetAttr(PathName & FileName) = vbDirectory Then

    Debug.Print FileName

    Worksheets("Interface").Cells(ROW, 14) = FileName

    End If

    FileName = Dir()

    ROW = ROW + 1


    End Sub

    Then with a bit of trim and vlookup i then used this script to move the folder

    Sub Copy_Folder()

    Dim FSO As Object

    Dim FromPath As String

    Dim ToPath As String

    If MsgBox("Are you sure you want to archive the DPR?", vbYesNo) = vbNo Then Exit Sub

    FromPath = "C:\Users\Lee Lowes\Music\Source\" & Worksheets("Interface").Range("M1").Value

    ToPath = Worksheets("Interface").Range("B41").Value & Worksheets("Interface").Range("M1").Value

    If Right(FromPath, 1) = "\" Then

    FromPath = Left(FromPath, Len(FromPath) - 1)

    End If

    If Right(ToPath, 1) = "\" Then

    ToPath = Left(ToPath, Len(ToPath) - 1)

    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath

    MsgBox "The DPR has been archived as requested "

    FSO.DeleteFolder FromPath

    End Sub

    Hope that makes a bit more sense. B41 on the to path, is a cell with the file path. The cell b41 automatically changes it's file path dependant on a date parameter formula. So come march, documents would then store in the march archive and so forth.



  • Please read the Forum Rules to understand how the Forum works and why I have added Code Tags to your post

    All VBA code posted in the forum must be wrapped in code tags, which you omitted, including single-line code snippets. Be sure to use them in future posts.

    How to use code tags

    Note: no apostrophe in the tags, just used for demonstration here.


    your code goes between these tags


    Or, just highlight all of the code and press the <> in the post menu above button to add the code tags.


Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!