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

  • 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?


    Regards,


    Lee

  • 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.


    Regards,


    Lee

  • 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


    Worksheets("Interface").Activate


    Range("N1:N500").ClearContents


    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

    Loop

    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.


    regards,


    Lee

  • 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.

    ['code]


    your code goes between these tags


    ['/code]


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


    Thanks.