• Viernes 24 de Febrero de 2017, 09:01

Autor Tema:  Macros para abrir cientos de archivos de textos enumerados de una carpeta  (Leído 213 veces)

warriors000

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
Macros para abrir cientos de archivos de textos enumerados de una carpeta
« en: Miércoles 14 de Septiembre de 2016, 21:35 »
0

Publicidad 
buenos dias. por fabor. soy nuevo en esto. mi codigo trabaja bien pero de una en una, queria saber que codigo 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 ofice 2013 y visual basic.
este es uno de los archivos de texto que tengo que importar:
despues de inportarlos les quito los saltos de linea (esto es muy importante) y pongo " al principio y al final del texto, asi:

despues 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:="1.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
------------------------------------------------------------
gracias por su ayuda. suerte.

warriors000

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
Re:Macros para abrir cientos de archivos de textos enumerados de una carpeta
« Respuesta #1 en: Miércoles 14 de Septiembre de 2016, 23:42 »
0
el codigo es de word 2013 visto en visual basic. para eliminar saltos de linea reemplazo “^p” (sin las comillas) por un espacio de la barra espaciadora. no selecciono la carpeta de origen,

solo gargo un archivo de texto en word y aplico el macros. me gustaria señalar la carpeta de entrada para importar los archivos enumerados: 1.txt, 2.txt, 3.txt,... hasta unos miles para

que se trabajen y despues de terminar inmediatamente se cierren hasta terminar con todas. por supuesto en esta carpeta solo habran archivos de texto enumerados como explique.

estos archivos de texto son bien simples, y algunos tienen 10 a 15 lineas. ejemplo:

bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla

a este comtenido le quito los saltos de linea y aumento unas comillas al principio y al final. ejemplo.

"bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla
bla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla blabla bla bla"

luego de esto con excel convierto los archivos de texto trabajados y los convierto a .csv para que todo el contenido se vea en una sola linea. estoy investigando desde antes de ayer pero

esta un poco dificil. gracias, suerte

--------------------------------------------------------------------
aqui dejo otro macros que me resulta pero esta ves importando desde la carpeta donde tengo los archivos de texto:
------------------------------------------------------------------------------------------------------
Sub Macro2222222()
'
' Macro2222222 Macro
'
'
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:=29
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=""""
ChangeFileOpenDirectory "D:\borrar\xxx"
ActiveDocument.SaveAs2 FileName:="1.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