Excel - reemplazar información

Private Sub Command1_Click()

Dim cont As Double

Dim fs As New FileSystemObject

Dim temporal As Folder

Dim Archivo As File

Dim nCarpetas, F, i As Integer

Dim TEXTO, motivo As String

On Error Resume Next

Dim filename As String

cont = 0

'App.Path & "\Print01.0000"

 F = 1

 i = 2

Set temporal = fs.GetFolder(Dir1.Path)     '("c:/cias/Rl/")

nCarpetas = temporal.SubFolders.Count

Screen.MousePointer = vbHourglass

For Each Archivo In temporal.Files  ' por cada archivo

cont = cont + 1

Label1.Caption = cont

Me.Refresh

     Call Reemplazar_Texto(temporal & "\" & Archivo.Name, ",100,", ",8555555555,")

Next Archivo

'*

    'DoEvents

Screen.MousePointer = vbDefault

Label1.Caption = cont & " Archivos Procesados·"

MsgBox "Proceso Completado"

End Sub

Private Sub Drive1_Change()

Dir1.Path = Drive1.Drive

End Sub

 'Sub que reemplaza las cadenas en el archivo por la nueva frase

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Reemplazar_Texto(ByVal El_Archivo As String, _

                            ByVal La_cadena As String, _

                            ByVal Nueva_Cadena As String)

On Error GoTo errSub

Dim F As Integer

Dim Contenido As String

    F = FreeFile

    'Abre el archivo para leer los datos

    Open El_Archivo For Input As F

    'carga el contenido del archivo en la variable

    Contenido = Input$(LOF(F), #F)

    'Cierra el archivo

    Close #F

    ' Ejecuta la función Replace, pasandole los datos

    Contenido = Replace(Contenido, La_cadena, Nueva_Cadena)

    F = FreeFile

    'Abre un nuevo archivo

    Open El_Archivo For Output As F

    'Graba los nuevos datos

    Print #F, Contenido

    'cierra el archivo

    Close #F

   ' MsgBox " Archivo modificado ", vbInformation

Exit Sub

'Error

errSub:

MsgBox Err.Description, vbCritical

Close

End Sub

Private Sub Form_Load()

Dir1.Path = "c:\"

End Sub