Search ".xls" files and then CUT and PASTE to new location

[afzalw]

I have a folder with many subfolders and I want to search ".xls" files from these subfolders and then cut and paste them to new location. There is a code available over interned for searching files in folder but apparently it does not work in newer versions of Excel.

 

[patel45]

Sub FileFindInSubfolders()
   Dim StrFile As String, objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   mFolder = Range("B2").Value ' folder
   fname = Range("B3").Value ' file name
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   mFolder = "D:\DATI\prova\"
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "\" & fname)
   If StrFile <> "" Then
      MsgBox mFolder & "\" & StrFile & " found"
   Else
     For Each mySubFolder In mainFolder.SubFolders
       StrFile = Dir(mySubFolder & "\" & fname)
       If StrFile <> "" Then
          MsgBox mySubFolder & "\" & StrFile & " found"
          Exit For
       End If
     Next
   End If
End Sub

 

[dmt32]

have you visited Rons site? Copy, Move and Delete files and folders

Dave

 

[afzalw]

Patel45 code extracts paths from the subfolders but does not copy or move them where as dmt32 code does not go in sub folders of main folders. Looks like I need something have the combination of these two codes.

 

[patel45]

A little work for you

 

[afzalw]

Work.... hmmmmm.. Okay I'll try to merge them :D