Macros para abrir cientos de archivos de textos enumerados de una carpeta que luego de trabajar se cierren

Soy nuevo en esto. Mi código trabaja bien pero de una en una, quería saber que código le puedo poner y en donde para que importe todos los archivos de texto enumerados ejemplo: 1.txt, 2.txt, 3.txt... Y desde luego se guarden en la carpeta especificada con el mismo nombre del archivo de texto. Tengo office 2013 y visual basic.

Este es uno de los archivos de texto que tengo que importar:

Después de inportarlos les quito los saltos de línea (esto es muy importante) y pongo " al principio y al final del texto, así:

pespues los guardo y los cierro. Mi codigo es este:

Sub Macrotexto1()
'
' Macrotexto1 Macro
' Macrotexto1
'
    ChangeFileOpenDirectory "D:\borrar\"
    Documents.Open FileName:="1.txt", ConfirmConversions:=False, ReadOnly:= _
        False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
        "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
        Format:=wdOpenFormatAuto, XMLTransform:="", Encoding:=1252
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.TypeText Text:=""""
    Selection.MoveDown Unit:=wdLine, Count:=24
    Selection.EndKey Unit:=wdLine
    Selection.TypeText Text:=""""
    ChangeFileOpenDirectory "D:\borrar\xxx\"
    ActiveDocument.SaveAs2 FileName:="5.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
        , LineEnding:=wdCRLF, CompatibilityMode:=0
    ActiveWindow.Close
End Sub

Esto lo hago para después convertir los archivos de texto en formato .csv para que quede todo el texto en una sola línea. Gracias por su ayuda. Suerte.

Añade tu respuesta

Haz clic para o