Buscar archivos, abrir (carpetas-subcarpetas)

Tengo un archivo en excel, en la columna A y de la fila 1 hasta la 45287 esta registrado el nombre de archivos con su respectiva extensión.
Nota
Estos archivos pueden estar en la raíz de un directorio y/o en subdirectorios.
Se requieren hacer tres actividades las cuales no se requieren hacer simultáneamente
Para cada caso la información esta en una hoja del mismo libro
[*]Lo primero que se requiere es identificar si el archivo que esta en cada fila de la columna A existe en la raíz del directorio o en sus subdirectorios, colocando al frente del archivo si existe o no existe.
[*][*]Lo segundo que se requiere es eliminar los archivos físicos que están en la raíz de un directorio y/o en subdirectorios a partir de un listado que esta en la columna A de la fila 1 hasta la 456, cada nombre esta registrado el nombre del archivo con su respectiva extensión.
[*][*][*]Lo tercero que se requiere es renombrar los archivos físicos que están en la raíz de un directorio y/o en subdirectorios a partir de un listado que esta en la columna A de la fila 1 hasta la 423, cada nombre esta registrado el nombre del archivo con su respectiva extensión y el nuevo nombre esta al frente sin la extensión.
La verdad he intentado pero no me ha ido bien con el tema de buscar el archivo en el directorio y/o subdirectorio.

Tengo un avance no es mucho pero ahí voy... Tengo problemas al visualizar el archivo

Sub abrir()
On Error Resume Next
Dim A As Integer
Dim B As Integer
Dim Directorio_Inicial As String
Dim Nombre_Archivo As String
Dim Direccion_Completa As String
'Dim Mostrar As String
Sheets("Hoja1").Select
Set fso = CreateObject("Scripting.filesystemObject")
Directorio_Inicial = "H:\Contrato 8600937\02-CB\2015\Informes PDF\Prueba 2\"
B = 1
For A = 1 To 7
Nombre_Archivo = Cells(A, B).Value
Direccion_Completa = Directorio_Inicial & Nombre_Archivo
    If fso.FileExists(Direccion_Completa) = True Then
        Mostrar = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" & Direccion_Completa, vbNormalFocus)
        Cells(A, 2) = "Existe"
    Else
        Cells(A, 2) = "No Existe"
    End If
Next A
End Sub

Añade tu respuesta

Haz clic para o