VBA macro that copy files from multiple subfolders -

i have vba copying images 1 folder based on image names. can check macro in work in attached. code is:

option explicit  sub copyfiles()     dim irow integer         ' row counter.     dim ssourcepath string     dim sdestinationpath string     dim sfiletype string      dim bcontinue boolean      bcontinue = true     irow = 2      ' source , destination folder path.     ssourcepath = "c:\users\nhatc_000\desktop\01010101\"     sdestinationpath = "c:\users\nhatc_000\desktop\02020202\"      sfiletype = ".jpg"      ' try other file types ".pdf".      ' loop through column "a" pick files.     while bcontinue          if len(range("a" & cstr(irow)).value) = 0    ' nothing if column blank.             msgbox "images have been moved. thank you!" ' done.             bcontinue = false         else             ' check if files exists.              if len(dir(ssourcepath & range("a" & cstr(irow)).value & sfiletype)) = 0                 range("b" & cstr(irow)).value = "does not exists"                 range("b" & cstr(irow)).font.bold = true             else                 range("b" & cstr(irow)).value = "on hand"                 range("b" & cstr(irow)).font.bold = false                  if trim(sdestinationpath) <> ""                     dim objfso                     set objfso = createobject("scripting.filesystemobject")                      ' check if destination folder exists.                     if objfso.folderexists(sdestinationpath) = false                         msgbox sdestinationpath & " not exists"                         exit sub                     end if                      '*****                     ' here have included 2 different methods.                     ' have commented second method. see result of                     ' second method, uncomment , comment first method.                      ' method 1) - using "copyfile" method copy files.                     objfso.copyfile source:=ssourcepath & range("a" & cstr(irow)).value & _                         sfiletype, destination:=sdestinationpath                      ' method 2) - using "movefile" method permanently move files.                     'objfso.movefile source:=ssourcepath & range("b" & cstr(irow)).value & _                         sfiletype, destination:=sdestinationpath                     '*****                 end if             end if         end if         irow = irow + 1      ' increment row counter.     wend end sub 

however, need 2 more things add code:

1. when enter name of file copied, want copy files have same name plus extension _01/_02/.../_07 if exist.
2. i want macro not inside specified folder in subfolders inside folder , subfolders inside subfolder etc.

can help? thanks!

what need recursive subs find similar filenames based on range value.

here approach goal below code couple of steps:

1. for each range value (stored key in dictionary), find file names (exact , similar item in dictionary). joining each finding "|" (an illegal file name character).
2. process dictionary items after files , sub folders source path
3. for each item in dictionary of key, see if existing file in destination folder. append " (i)" destination file name if exists.
4. copy destination file destination folder.

5. while copying, returns

6. stop looping when first empty cell encountered

note: code not been tested, compiled fine

option explicit      ' source , destination folder path. private const ssourcepath = "c:\users\nhatc_000\desktop\01010101\" private const sdestinationpath = "c:\users\nhatc_000\desktop\02020202\" private const sfiletype = "jpg"        ' try other file types ".pdf". private const div = "|" ' character that's not legal file name  private objfso object, objdict object  sub copyfilesalike()     dim lrow long, sname string     set objfso = createobject("scripting.filesystemobject")     if not objfso.folderexists(ssourcepath)         msgbox "source folder not found!" & vbcrlf & ssourcepath, vbcritical + vbokonly         goto i_am_done     end if     if not objfso.folderexists(sdestinationpath)         msgbox "destination folder not found!" & vbcrlf & sdestinationpath, vbcritical + vbokonly         goto i_am_done     end if     ' proceed when both source , destination folders found     set objdict = createobject("scripting.dictionary")     lrow = 2     until isempty(cells(lrow, "a")) ' stop on first empty cell in column lrow         ' main file name         sname = cells(lrow, "a").value         ' files (exact , alikes sub folders) add dictionary         lookforfilesalike sname, objfso.getfolder(ssourcepath)         ' copy files         if objdict.count = 0             cells(lrow, "b").value = "no files found."         else             cells(lrow, "b").value = objdict.count & " filenames(s) found." & vblf & copyfiles         end if         ' clear dictionary next name         objdict.removeall         ' increment row counter         lrow = lrow + 1     loop     set objdict = nothing  i_am_done:     set objfso = nothing end sub  private sub lookforfilesalike(byval sname string, byval objfdr object)     dim ofile object, ofdr object     ' add files of current folder dictionary if name matches     each ofile in objfdr.files         if instr(1, ofile.name, sname, vbtextcompare) = 1 ' names beginning sname             ' check extension match             if lcase(objfso.getextensionname(ofile)) = lcase(sfiletype)                 if objdict.exists(ofile.name)                     ' append path existing entry                     objdict.item(ofile.name) = objdict.item(ofile.name) & div & ofile.path                 else                     ' add key , current path                     objdict.add ofile.name, ofile.path                 end if             end if         end if     next     ' recurse each sub folder     each ofdr in objfdr.subfolders         lookforfilesalike sname, ofdr     next end sub  private function copyfiles() string     dim long, okeys variant, oitem variant, irepeat integer, sname string, sout string     sout = ""     ' process items each key in dictionary     set okeys = objdict.keys ' <- add "set " before okeys     = 0 objdict.count         each oitem in split(objdict.item(okeys(i)), div)             ' determine filename in destination path             if objfso.fileexists(sdestinationpath & objfso.getfilename(oitem))                 ' same file name alreay found, try append " (i)"                 irepeat = 0                                     irepeat = irepeat + 1                     sname = objfso.getbasename(oitem) & " (" & irepeat & ")" & objfso.getextensionname(oitem)                 loop while objfso.fileexists(sdestinationpath & sname)                 sname = sdestinationpath & sname             else                 ' first file copied destination folder                 sname = sdestinationpath             end if             ' copy source file destination file             if len(sout) = 0                 sout = oitem & div & sname             else                 sout = sout & vblf & oitem & div & sname             end if             objfso.copyfile oitem, sname         next     next     copyfiles = sout end function