** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Visual Basic Clásico (VB3...VB6)
  Mensajes nuevos Mensajes nuevos RSS - Macros para abrir cientos de archivos de textos en
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoMacros para abrir cientos de archivos de textos en

 Responder Responder
Autor
Mensaje
warriors000 Ver desplegable
Nuevo
Nuevo


Unido: 14/Septiembre/2016
Localización: peru
Estado: Sin conexión
Puntos: 8
Enlace directo a este mensaje Tema: Macros para abrir cientos de archivos de textos en
    Enviado: 14/Septiembre/2016 a las 21:25
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.
Arriba
warriors000 Ver desplegable
Nuevo
Nuevo


Unido: 14/Septiembre/2016
Localización: peru
Estado: Sin conexión
Puntos: 8
Enlace directo a este mensaje Enviado: 14/Septiembre/2016 a las 23:41
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
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Prisión Brieva
Estado: Sin conexión
Puntos: 3174
Enlace directo a este mensaje Enviado: 16/Septiembre/2016 a las 00:33
¿Los guardas como .DOC o como .TXT?

Porque si son .TXT es bastante más fácil que lo que estás haciendo, es más, probablemente puedas hacer los cambios en los TXT y copiarlo al .DOC

Sería cuestión de abrir el archivo , cargarlo en memoria, quitar los saltos de lúnea y aññadirle comillas al inicio y al final, luego, si es texto guardarlo y si es .doc. pegarlo en el documento y guardarlo como .DOC.

Para cargar el fichero, te puede valer esto: http://www.mvp-access.com/foro/copiar-textos-largos-a-campo-memo_topic81671.html?KW=
Y para los saltos de línea mira esto: http://www.mvp-access.com/foro/contar-saltos-de-lnea_topic80128.html?KW=

Un saludo.

Luis
Those are my principles, and if you don't like them... well, I have others. Groucho Marx
Arriba
warriors000 Ver desplegable
Nuevo
Nuevo


Unido: 14/Septiembre/2016
Localización: peru
Estado: Sin conexión
Puntos: 8
Enlace directo a este mensaje Enviado: 16/Septiembre/2016 a las 16:49
hola ibauluz gracias por aportar. te explico, buscando en internet encontre este codigo y me resulto con 500 archivos, abajo lo pongo,  pero no se si será el adecuado. estos archivos csv son de puro texto donde no tienen comas por que los removí. son de varias lineas que incluyen saltos de linea. no son para trabajar en excel. ejemplo:

"La historia es la ciencia que tiene como objeto de estudio el pasado de la humanidad y como método el propio de las ciencias sociales.
Se denomina también historia al periodo que transcurre desde la aparición de la escritura hasta la actualidad " y algunos archivos son mucho más extensos.

como veras es texto simple. cuando importas estos archivos en excel el programa automaticamente los coloca en celdas que en este caso estan demás, por que lo que se necesita es solamente importarlos para enseguida exportarlos como csv tal como estaban antes. en pocas palabras convertirlos o limpiarlos de alguna manera que otros programas los puedan leer sin problemas por que todos estan con defectos pues les cambié la extencion de .txt a .csv con un programa parecido a winrrar. cuando aplique esta macro que pongo a continuacion ocurrió lo que dije arriba y se exportaron a la carpeta mis documentos todos los archivos que se importaron, sin errores.

Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path & "D:\borrar"
Set fso = CreateObject("scripting.filesystemobject")
Set carpeta = fso.getfolder(ruta)
For Each fichero In carpeta.Files
If fichero = ruta & mio Then GoTo salto
If fichero = ruta & "~$" & mio Then GoTo salto2
Workbooks.Open fichero
ActiveWorkbook.SaveAs , FileFormat:=xlCSV
otro = ActiveWorkbook.Name
Workbooks(otro).Close True
salto:
Next
salto2:
End Sub

ojalá esto le ayude a más personas que tengan el mismo problema. por fabor revisalo y dime que le falta a este codigo para que elimine todos los saltos de linea a todos los archivos .csv antes de ser exportados, para que cuando salgan esten todas en una sola linea. muchas gracias otra vez, suerte.
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Prisión Brieva
Estado: Sin conexión
Puntos: 3174
Enlace directo a este mensaje Enviado: 16/Septiembre/2016 a las 21:27
Mete el texto en una variable y aplica esto (suponiendo que la variable se llame xx)

dim xx as string
 xx = Replace (Replace (xx, Chr(10), " "), Chr(13), " ")

Un saludo

Luis


Editado por lbauluz - 16/Septiembre/2016 a las 21:27
Those are my principles, and if you don't like them... well, I have others. Groucho Marx
Arriba
warriors000 Ver desplegable
Nuevo
Nuevo


Unido: 14/Septiembre/2016
Localización: peru
Estado: Sin conexión
Puntos: 8
Enlace directo a este mensaje Enviado: 17/Septiembre/2016 a las 15:58
hola ibauluz, muchas gracias por la ayuda, no soy programador soy novato y lo que se, es por la informacion que consigo mediante la web y tutoriales que me resulta muy dificil aprender, solo consigo saber para que sirven algunos codigos. podrias porfabor colocarlo  tu con copiar y pegar. ten en cuenta que son miles de archivos las cuales tengo que importar y exportar y son algunos un poco extensos. gracias por tu tiempo, saludos
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Prisión Brieva
Estado: Sin conexión
Puntos: 3174
Enlace directo a este mensaje Enviado: 18/Septiembre/2016 a las 17:06
Hola warriors000, lo primero es recordarte que esto no es una academia, pero por esta vez, te voy a dar parte de la solución hecha.

Lo que necesitas es abrir el fichero, quitar comas, quitar saltos de línea y guardarlo, ni tan siquiera necesitas pegarlo en excel o Word.

NO voy a decirte como abrir todos los archivos ni como guardarlos, eso te va a quedar de tarea) recuerda que la misión de este foro es que la gente aprenda y luego colabore con nosotros ayudando a otros)

El código que necesitas es este: (Más la función que te puse el enlace anteriormente)



Sub inicio()
    Dim xx As String
    Dim xy As String
    
    Dim n As Long
    ' Cargar el fichero en memoria
    xx = bin2var("c:\Temp\a.txt") ´este nombre lo tienes que reemplazar cada vez por el nombre de tu archivo
    ' quitar comas y saltos de linea
'    xx = " la gallina turuleta"
    xx = fQuitaComas(xx)    ' comas
    xx = Replace(Replace(xx, Chr(10), " "), Chr(13), " ")
    ´Guardar xx como archivo
End Sub

Public Function fQuitaComas(strString As String)
    Dim lonPosi As Long
    Dim lonLong As Long
    Dim strRight As String
    Dim strChar As String
    
    strRight = strString
    strChar = ","
    lonLong = Len(strChar)
    lonPosi = InStr(1, strRight, strChar)
    
    If lonPosi = 0 Then         ' No hay comas, retornar misma cadena
        fQuitaComas = strString
        Exit Function
    End If
        
    While Not lonPosi = 0
        fQuitaComas = fQuitaComas & Left(strRight, lonPosi - 1)
        strRight = Mid(strRight, lonPosi + 1)
        lonPosi = InStr(1, strRight, strChar)
    Wend

    fQuitaComas = fQuitaComas & strRight
End Function


Un saludo.

Luis
Those are my principles, and if you don't like them... well, I have others. Groucho Marx
Arriba
warriors000 Ver desplegable
Nuevo
Nuevo


Unido: 14/Septiembre/2016
Localización: peru
Estado: Sin conexión
Puntos: 8
Enlace directo a este mensaje Enviado: 25/Septiembre/2016 a las 07:30
muchas gracias,  por lo de la tarea, tienes mucha razon, así se aprende, investigando. me despido, un abrazo desde perú, suerte.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable