Create FOLDER in subfoldesr and move folders with specific names into FOLDER

Hi,

the below code creates a "2013" Folder in all the subfolder and move any "FILE having 2013 in it's name" to "2013" Folder, is it possible to move any "SUBFOLDER that has 2013 in it's name" to "2013" Folder? Current code moves only Files that have 2013 in their name but not subfolders that have 2013 in their name.

Please Login or Register  to view this content.

Sub AddSubfolder()
'Under tools, add reference to Microsoft Scripting Runtime
Dim FSO As Scripting.FileSystemObject
Dim RootFolder As Object
Dim SubFolder As Object
Dim myFolder As String
Dim myNewFolder As String
Dim mySubfolderPath As String
Dim myFile As String
Set FSO = CreateObject("Scripting.FileSystemObject")
myFolder = "D:\Users\703038355\Desktop\oFile\" 'Change to identify your main folder
Set RootFolder = FSO.GetFolder(myFolder)
For Each SubFolder In RootFolder.SubFolders
Debug.Print SubFolder.Path
mySubfolderPath = SubFolder.Path
myNewFolder = mySubfolderPath & "\2013"
If Not FSO.FolderExists(myNewFolder) Then
MkDir (myNewFolder)
myFile = Dir(mySubfolderPath & "\*2013*")
Do While myFile <> ""
FSO.MoveFile mySubfolderPath & "\" & myFile, myNewFolder & "\" & myFile

myFile = Dir
Loop

End If
Next SubFolder

End Sub

Please Login or Register  to view this content.

Thanks in advance.

Amar

Hi Amar,

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between

Please Login or Register  to view this content.

tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here


Go through this Link - http://www.excelforum.com/forum-rule...rum-rules.html