vba - list full details from files in folders and sub folder in excel -

i'm trying create document register in end list files within chosen folder , sub folders, have code below lists files , path. though can't think need add code excel sheet create column lists file type "pdf","txt",dwg" etc. column uses predefined list show type of file these (i.e. pdf=document, dwg=cad file etc.).

the next thing want add hyperlink generated path column.

finally there way in can make excel ignore collected data, folder data collected updated regularly , able run vba ignore sub folders has pulled data from.

any appreciated.

option explicit 'the first row data const row_first integer = 5  'this event handler. exectues when user 'presses run button private sub btnget_click() 'determines if user selects directory 'from folder dialog dim intresult integer 'the path selected user 'folder dialog  dim strpath string 'filesystem object dim objfso object 'the current number of rows dim intcountrows integer application.filedialog(msofiledialogfolderpicker).title = _ "select path"  'the dialog displayed user intresult = application.filedialog( _ msofiledialogfolderpicker).show 'checks if user has cancled dialog if intresult <> 0 strpath = application.filedialog(msofiledialogfolderpicker _ ).selecteditems(1) 'create instance of filesystemobject set objfso = createobject("scripting.filesystemobject")  'loops through each file in directory , prints 'names , path intcountrows = getallfiles(strpath, row_first, objfso) 'loops through files , folder in input path call getallfolders(strpath, objfso, intcountrows)    end if end sub  ''' 'this function prints name , path of files 'in directory strpath 'strpath: path list of files 'introw: current row start printing file names 'in 'objfso: scripting.filesystem object.  private function getallfiles(byval strpath string, _ byval introw integer, byref objfso object) integer dim objfolder object dim objfile object dim integer = introw - row_first + 1 set objfolder = objfso.getfolder(strpath) each objfile in objfolder.files     'print file name     cells(i + row_first - 1, 1) = objfile.name     'print file path     cells(i + row_first - 1, 2) = objfile.path     = + 1 next objfile getallfiles = + row_first - 1 end function  ''' 'this function loops through folders in 'input path. makes call getallfiles 'function. makes recursive call 'strfolder: folder loop through 'objfso: scripting.filesystem object 'introw: current row print file data on private sub getallfolders(byval strfolder string, _ byref objfso object, byref introw integer) dim objfolder object dim objsubfolder object  'get folder object set objfolder = objfso.getfolder(strfolder) 'loops through each file in directory , 'prints names , path each objsubfolder in objfolder.subfolders introw = getallfiles(objsubfolder.path, _     introw, objfso) 'recursive call to itsself call getallfolders(objsubfolder.path, _     objfso, introw) next objsubfolder end sub 

solution: make following changes in function getallfiles - works me:

after dim integer, add:

dim extension string 

after cells(i + row_first - 1, 2) = objfile.path, add:

extension = right(objfile.path, len(objfile.path) - instrrev(objfile.path, ".")) cells(i + row_first - 1, 3) = extension cells(i + row_first - 1, 4) = objfile.type cells(i + row_first - 1, 5).formula = "=hyperlink(""" & objfile.path & """,""link"")" 

explanation: extension variable populated looking dot . in filename , using right of dot. added next column. description of extension taken file object's type attribute. lastly, rightmost column filled =hyperlink function pointing @ file , path.

---

edit: edited after hint of @timwilliams (thank you!), simplified above code. if need customized file type descriptions, use below approach instead , replace

cells(i + row_first - 1, 4) = objfile.type 

with

on error resume next cells(i + row_first - 1, 4) = application.worksheetfunction.vlookup(extension, _     activeworkbook.sheets("filetypes").range("a:b"), 2, false) 

before running this, need add 1 worksheet called filetypes , put common extensions in column , long text / explanation column b:

to list without work, copy find on website, , remove dots . using search & replace function.