VBA file listing (1 of 3) - shorten filepath

[Dr. Demento]

I've managed to cobble together some truly awesome work to compile a listing of all files within a directory (including subdirectories); you folks out there are amazing (shout out to azurous)!
I'm wanting to streamline the filepath output and I'm stuck. As it's written, the code provides the full file path for each individual file (column E); I would like to have the starting filepath listed once (cell E2) and the filepaths for each file be a truncated version (see column G for example), showing only the folder that was originally chosen + any subdirectory. This will capture all the filepath for the files within the "parent" directory and the "child" directories, but without the full filepath for each individual file.

I thought about using left/right functions, but I don't know how to truncate based on an entire string (E2). Any thoughts or suggestions would be much appreciated.

 

[NARAYANK991]

Hi ,

I am not sure I have understood you , but see your file now and comment.

Narayan

 

[Dr. Demento]

I was hoping that each row would have the abbreviated filepath listed. I guess I'm looking for the VBA equivalent of this formula (copied into G2 - see attached):

="\"&REPLACE($E5,1,FIND("??",SUBSTITUTE($E5,"\","??",LEN($E$2)-LEN(SUBSTITUTE($E$2,"\",""))-1)),"") where E2 = Parent File Path and
LEN($E$2)-LEN(SUBSTITUTE($E$2,"\",""))-1) = Number of "\" within Parent File Path.

Thoughts?

 

[p45cal]

I didn't realise that Narayan had already answered, but I've done some work so try this:
1. Add the line

Dim StartFolder As String

after the line near the top of the code module:

Const ROW_FIRST As Integer = 5  'the first row with data

2. In btnGet_Click, add the line:

StartFolder = strPath

after the line:

strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)  'Create an instance of the FileSystemObject

3. In GetAllFiles change the line:

Cells(i + ROW_FIRST - 1, 5) = Left(objFile.Path, InStrRev(objFile.Path, "\") - 1)  'http://www.exceltrick.com/formulas_macros/vba-instr-function/

to:

Cells(i + ROW_FIRST - 1, 5) = Replace(Left(objFile.Path, InStrRev(objFile.Path, "\") - 1), StartFolder, "", , , vbTextCompare) 'http://www.exceltrick.com/formulas_macros/vba-instr-function/

It's not quite the same as you asked for but that can be put right by tweaking the line:

StartFolder = strPath

Regarding hyperlinks, try:
1. Changing the line in GetAllFiles:

Cells(i + ROW_FIRST - 1, 1) = Left(objFile.Name, InStrRev(objFile.Name, ".") - 1) 'http://www.thespreadsheetguru.com/the-code-vault/2014/3/2/retrieving-the-file-name-extension-from-a-file-path-string

to:

Hyperlinks.Add Anchor:=Cells(i + ROW_FIRST - 1, 1), Address:=objFile.Path, TextToDisplay:=Left(objFile.Name, InStrRev(objFile.Name, ".") - 1)

but I'm not sure what you mean by making a hyperlink "invisible".

Regarding excluding some files, perhaps an If.. ..End if around the code which writes to the sheet, currently in GetAllFiles you have:

For Each objFile In objFolder.Files
'code to write to sheet here.
Next objFile

which you can change to:

For Each objFile In objFolder.Files
  If objFile.Size > 0 And Left(objFile.ShortName, 1) <> "$" And IsError(Application.Match(objFile.Name, Array("thumbs.db", "trap.txt", "db.zzz", "something.xls"), 0)) Then
      'code to write to sheet here.
   End If
Next objFile

Here you can see I've included 3 types of condition, examining the file size, the first character of the file name, and the whole filename and whether it's included in a list.

 

[Dr. Demento]

I didn't realise that Narayan had already answered, but I've done some work so try this:
1. Add the line

Dim StartFolder As String

after the line near the top of the code module:

Const ROW_FIRST As Integer = 5  'the first row with data

2. In btnGet_Click, add the line:

StartFolder = strPath

after the line:

strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)  'Create an instance of the FileSystemObject

3. In GetAllFiles change the line:

Cells(i + ROW_FIRST - 1, 5) = Left(objFile.Path, InStrRev(objFile.Path, "\") - 1)  'http://www.exceltrick.com/formulas_macros/vba-instr-function/

to:

Cells(i + ROW_FIRST - 1, 5) = Replace(Left(objFile.Path, InStrRev(objFile.Path, "\") - 1), StartFolder, "", , , vbTextCompare) 'http://www.exceltrick.com/formulas_macros/vba-instr-function/

It's not quite the same as you asked for but that can be put right by tweaking the line:

StartFolder = strPath

Regarding hyperlinks, try:
1. Changing the line in GetAllFiles:

Cells(i + ROW_FIRST - 1, 1) = Left(objFile.Name, InStrRev(objFile.Name, ".") - 1) 'http://www.thespreadsheetguru.com/the-code-vault/2014/3/2/retrieving-the-file-name-extension-from-a-file-path-string

to:

Hyperlinks.Add Anchor:=Cells(i + ROW_FIRST - 1, 1), Address:=objFile.Path, TextToDisplay:=Left(objFile.Name, InStrRev(objFile.Name, ".") - 1)

but I'm not sure what you mean by making a hyperlink "invisible".

Regarding excluding some files, perhaps an If.. ..End if around the code which writes to the sheet, currently in GetAllFiles you have:

For Each objFile In objFolder.Files
'code to write to sheet here.
Next objFile

which you can change to:

For Each objFile In objFolder.Files
  If objFile.Size > 0 And Left(objFile.ShortName, 1) <> "$" And IsError(Application.Match(objFile.Name, Array("thumbs.db", "trap.txt", "db.zzz", "something.xls"), 0)) Then
      'code to write to sheet here.
   End If
Next objFile

Here you can see I've included 3 types of condition, examining the file size, the first character of the file name, and the whole filename and whether it's included in a list.

P45cal - Wow! That worked spectacularly!!! Thank you so very much.