CountDir

Private Function ChDirUp(ptStartDir As String, lDirsToGoUp As Long) As String
On Local Error Goto ErrorHandler
Dim lCur As Long
Dim tTemp As String
Dim fsoTemp As FileSystemObject
Dim fsoFolder As Folder

Set fsoTemp = New FileSystemObject
Set fsoFolder = fsoTemp.GetFolder(ptStartDir)

lCur = 0
tTemp = ptStartDir
While lCur <> lDirsToGoUp
tTemp = fsoFolder.ParentFolder.Path
Set fsoFolder = Nothing
Set fsoFolder = fsoTemp.GetFolder(tTemp)
lCur = lCur + 1
Wend

Set fsoFolder = Nothing
Set fsoTemp = Nothing

ChDirUp = tTemp
Exit Function
ErrorHandler:
ChDirUp = tTemp
End Function