** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - VBA: Fusionar ficheros de texto
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA: Fusionar ficheros de texto

 Responder Responder
Autor
Mensaje
admin Ver desplegable
Administrador
Administrador
Avatar

Unido: 14/Agosto/2013
Localización: Cualquier lugar
Estado: Sin conexión
Puntos: 790
Enlace directo a este mensaje Tema: VBA: Fusionar ficheros de texto
    Enviado: 14/Agosto/2013 a las 20:51
Emilio Sancha 2004
 
 
Hace unos días salio este tema en una conversación y llegamos a varias conclusiones, como casí siempre tenemos diferentes posibilidades para hacer lo mismo.
Ahí van todas ellas,
la antediluviana, mediante un fichero bat, esta como no, es de Battle Troll
<inicio de tu .BAT>
@echo off
copy /b c:\gm001\arch1.txt + c:\gm001\arch2.txt c:\gm001\arch3.txt
del c:\gm001\arch2.txt
ren c:\gm001\arch3.txt c:\gm001\arch2.txt
<fin de tu .BAT>

el mismo metodo, pero sin bat, mediante una llamada al command.com (ojo en NT y XP es cmd.exe), esta otra es de gabopug

Sub nueva()
  Shell "c:\winnt\system32\command.com /c copy c:\archivo3.txt+c:\archivo1.txt+c:\archivo2.txt c:\archivo3.txt"
End Sub
 

Mediante el clasico sistema Basic (esta es de D.Vazquez)

Private Sub Command0_Click()
  'Declara el archivo que quieres copiar
  Dim SourceNum As Integer
  Dim DestNum As Integer
  Dim Temp As String 'Solo si el archivo contiene encabezados
  ' If an error occurs, close the files and end the sub.
  On Error GoTo ErrHandler
  ' Abre el archivo donde se va a anexar los datos.
  DestNum = FreeFile()
  Open "c:\archivodestino.txt" For Append As DestNum
  ' Abre el archivo que vas a copiar
  SourceNum = FreeFile()
  Open "c:\archivofuente.txt" For Input As SourceNum
  ' Incluye la siguiente linea solamente si el archivo fuente contiene una linea de encabezados y la qiueres copiar al archivo destino:
  ' Line Input #SourceNum, Temp
  ' Lee cada linea del arcihvo fuente y copiala al archivo destino
  Do While Not EOF(SourceNum)
    Line Input #SourceNum, Temp
    Print #DestNum, Temp
  Loop
CloseFiles:
  ' Close the destination file and the source file.
  Close #DestNum
  Close #SourceNum
ErrHandler:
  'Error trapper
End Sub
 
esta otra de Juan M.Afán de Ribera, parecida pero más depurada
 
 

Dim cadena As String
Open "FicheroRefundido.txt" For Append As #1
Open "fichero1.txt" For Input As #2
Open "fichero2.txt" For Input As #3
' recuperamos la totalidad de "fichero1.txt"
' en la variable cadena y lo insertamos en
' "FicheroRefundido.txt"
cadena = Input(LOF(2), #2)
Print #1, cadena
' recuperamos la totalidad de "fichero2.txt"
' en la variable cadena y lo insertamos en
' "FicheroRefundido.txt"
cadena = Input(LOF(3), #3)
Print #1, cadena
Close

Y por ultimo mediante vbs, esta es mía y solo por eso la mejor, perdón quiero decir que no por eso es la mejor . Coñas aparte esta tiene la ventaja de que admite multiples ficheros de "entrada".
 
 
 

'*******************************************************************************
'* FusionarArchivos
'* Fusiona multiples archivos de texto en uno nuevo
'* Argumentos: strArchivoSalida => Archivo destino de los refundidos
'*             strArchivos      => Relación de archivos a refundir, separados por comas
'* uso: FusionarArchivos "C:\f.txt", "C:\a.txt", "C:\b.txt", "C:\c.txt", "C:\d.txt", "C:\e.txt"
'* ESH 01/02/05 21:37
'* ESH 04/02/05 19:34 | ahora admite multiples archivos mediante un ParamArray
'*******************************************************************************
 
Sub FusionarArchivos(strArchivoSalida As String, ParamArray strArchivos() As Variant)
  Const ParaLectura = 1, _
        ParaEscritura = 2
  Dim fso As Object, _
      Archivo As Object, _
      strArchivo1 As String, _
      i As Long
  On Error GoTo FusionarArchivos_TratamientoErrores
  Set fso = CreateObject("Scripting.FileSystemObject")
  fso.CreateTextFile (strArchivoSalida)
  For i = 0 To UBound(strArchivos)
    Set Archivo = fso.OpenTextFile(strArchivos(i), ParaLectura, True)
    strArchivo1 = strArchivo1 & vbCrLf & Archivo.ReadAll
  Next i
  Set Archivo = fso.OpenTextFile(strArchivoSalida, ParaEscritura)
  Archivo.Write strArchivo1
  Set fso = Nothing
  Set Archivo = Nothing 
FusionarArchivos_Salir:
  On Error GoTo 0
  Exit Sub
 
FusionarArchivos_TratamientoErrores:
  MsgBox "Error " & Err.Number & " en proc.: FusionarArchivos de Documento VBA: Form_Formulario6 (" & Err.Description & ")"
  GoTo FusionarArchivos_Salir
End Sub               ' FusionarArchivos

 


Editado por admin - 14/Agosto/2013 a las 20:58
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable