Truncating Array Results in a List Box

[rrenis]

Hi all - This is really a continuation of a previous thread (http://vbaexpress.com/forum/showthread.php?t=12614), once again thanks to JimmyTheHand and Simon Lloyd for their feedback and help.

I have the following code which works great but I wondered whether it would be possible to truncate the array results so the directories are displayed from a certain point. I initially thought this would be straight forward using MID but I've been unable to figure out where to insert this in the code, if indeed this is the solution. If anyone has the free time could you please point me in the right direction?

[vba]Option Explicit
Const ARRAY_INITIAL = 1000
Const ARRAY_INCREMENT = 100
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long
Dim arrFiles() As String

Private Sub CommandButton1_Click()

Dim x As Integer

ListBox1.Clear
ListBox1.Visible = False

Call spanFolders("C:\These are all my Current Projects\", "*.*")

For x = 0 To UBound(arrFiles)
ListBox1.AddItem arrFiles(x)
Next x
ListBox1.Visible = True

End Sub

Public Function spanFolders(startfolder As String, srchstr As String)

Dim sFilename As String
Dim sfoldername As String
Dim idx As Integer
Dim limit As Integer

ReDim arrFiles(ARRAY_INITIAL)
On Error GoTo errHandle

idx = 0
arrFiles(0) = startfolder
limit = 1
Do While idx < limit
sfoldername = arrFiles(idx)
sFilename = Dir(sfoldername & srchstr, vbDirectory)
Do While (sFilename <> "") And (DirLevel(sfoldername) < 4)

If GetFileAttributes(sfoldername & sFilename) = _
FILE_ATTRIBUTE_DIRECTORY Then
If sFilename <> "." And sFilename <> ".." Then
arrFiles(limit) = sfoldername & _
sFilename & "\"
limit = limit + 1
End If

End If
sFilename = Dir
Loop
idx = idx + 1
Loop

ReDim Preserve arrFiles(limit - 1)

Exit Function

errHandle:
If Err.Number = 9 Then
ReDim Preserve arrFiles(UBound(arrFiles) + _
ARRAY_INCREMENT)
Resume
Else
Err.Raise Err.Number, Err.Source, Err.Description
End If

End Function
Public Function DirLevel(fldr As String) As Long
Dim i As Long, result As Long
result = 0
For i = 1 To Len(fldr)
If Mid(fldr, i, 1) = "\" Then result = result + 1
Next
DirLevel = result
End Function[/vba]

I'd like to be able to display the resulting folders without the starting folder (or at any point if possible). i.e.

C:\These are all my Current Projects\One of my projects\
C:\These are all my Current Projects\Another one of my projects\
C:\These are all my Current Projects\Yet another one of my projects\ etc

would be displayed in the list box as...

One of my projects\
Another one of my projects\
Yet another one of my projects\ etc

The reason for this is that some of the folder names in which my projects are stored are quite long and if I use the option in my userform to display the sub folders too by omitting the reference to the DirLevel Function then thing get a bit messy.

Thanks

Cheers,
rrenis

[matthewspatrick]

[VBA]ListBox1.AddItem Split(arrFiles(x), "C:\These are all my Current Projects\")(1)[/VBA]

[rrenis]

Hi Patrick - Thanks for the reply! It works great!

Cheers,
rrenis