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