Visual Basic - Trabajo Con archivos

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

filename = Dir1.Path & "\BASEx.TXT"   'App.Path & "\Print01.0000"

 F = 1

 i = 2

Set temporal = fs.GetFolder(Dir1.Path) ' La carpeta donde estara el archivo. 

nCarpetas = temporal.SubFolders.Count

Screen.MousePointer = vbHourglass

For Each Archivo In temporal.Files  ' por cada archivo

cont = cont + 1

Label1.Caption = cont

            Open Archivo For Input As F

                 While Not EOF(F)

                    Line Input #F, Texto

                Wend

             Close F

           Open filename For Append As i

                        Print #i, Texto

           Close i

 Next Archivo

'*

    'DoEvents

Screen.MousePointer = vbDefault

Label1.Caption = cont & " Archivos Procesados·"

MsgBox "Proceso Completado"

End Sub