Visual Basic - Escanear recursivamente C:\

Hola necesito recorrer todo el disco duro en busca de files ",doc", ".xls"...etc,me lo hace bien pero llegado mi indice a 2300 (y pico) me sale error de desbordamiento.No uso filesystemObject para recorrer pero estoy abierto a sugerencias.Mi codigo funciona hasta que el indice es igual a 2000 y pico.
Muchas gracias por adelantado
Mi codigo es el siguiente:
-----------------------------------------------------------------------------------------------------
unidad = "C:\"
ruta = unidad
rutaBorrar = "\\carpeta\" & ip
nuevo = "s" 'para el mkdir,indicarle q la carpeta con la ip tiene q crearla
Indice = 1
Arbol.Add unidad
Fin = False

'Borramos el diretorio en el que vamos a hacer la copia si existe
If (objFile.FolderExists(rutaBorrar) = True) Then
objFile.DeleteFolder (rutaBorrar)
End If

'Empezamos a recorrer el disco duro
While Not Fin
If GetAttr(Arbol.Item(Indice)) = 16 Or GetAttr(Arbol.Item(Indice)) = 54 Then ' si es carpeta o unidad hacer...
Carpetas = Dir(Arbol.Item(Indice) + "\*.*", vbDirectory) 'Recoge el nombre del archivo - carpeta
While Carpetas <> "" 'Mientras halla contenido en carpeta
If Carpetas <> "." And Carpetas <> ".." And Trim(Carpetas) <> "" Then
Arbol.Add Arbol.Item(Indice) + "\" + Carpetas 'guarda archivo o carpeta en la colección
End If
Carpetas = Dir 'Recorre el contenido de la carpeta

'Me quedo con el nombre del objeto a escanear
nombreArchivo = Carpetas
ruta = Arbol.Item(Indice) & "\" & Carpetas 'Guardo la ruta completa

posPunto = InStr(Carpetas, ".")
longitudCadena = Len(Carpetas) + 1

If posPunto <> 0 Then 'si tiene extension el objeto
extension = Mid(Carpetas, posPunto, longitudCadena - posPunto)
If extension = ".doc" Or extension = ".xls" Or extension = ".ppt" Or extension = ".pps" Or extension = ".mdb" Or extension = ".pdf" Then
If nuevo = "s" Then
MkDir ("\\carpeta\" & ip)
nuevo = "n"
End If
FileCopy ruta, "\\carpeta\" & ip & "\" & nombreArchivo
End If
End If

posPunto = 0 'inicializo la posicion del punto para la siguiente entrada
Wend
End If 'Si sale aqui es que ya no hay mas carpetas - archivos

DoEvents 'hace que la tarea sea sana y no sature el procesador
Indice = Indice + 1 'AKI EN EL 2000 Y PICO SE DESBORDA pasa al siguiente items para visar
If Arbol.Item(Indice) = Arbol.Item(Arbol.Count) And GetAttr(Arbol.Item(Indice)) <> vbDirectory Then
Fin = True 'si el ultimo items guardado no es carpeta hay fin de busqueda
End If
Wend