Archivos .rtf a excel

[rzamoras]

Buenos días,

Solicito su ayuda para pasar el contenido de 12000 archivos en formato .rtf dentro de una carpeta con historia clínicas, requiero pasar estos datos a una base de Excel para usarlos posteriormente en Access.

En una columna debe estar el nombre del archivo ya que esta vinculado a la ID del paciente, y en otra columna el contenido del archivo.

Ya busque en el foro, encontré una macro para pasar txt pero no me funciono, se bloquea el archivo de Excel y no responde.

Gracias

Rene Zamora

[Janlui]

Hola, como ejercicio podrias subir unos 3 o 5 archivos RTF para hacer las pruebas.

Por otro lado, tendras en excel la lista de esos 12000 archivos RTF?

Saludos.

[rzamoras]

Hola @Janlui anexo archivo de excel con 10 elementos, el la última columna deseo pasar los datos de la carpeta anexa de Historias a la hoja de excel en RTF.

Gracias por la ayuda!!

 

Identificacion-Prueba.zip

[Janlui]

ESTA SERIA LA IDEA?

Identificacion-Prueba.xlsx

[rzamoras]

Es correcto!! Esa es la idea.

[Janlui]

1. Tu tienes forma de convertirlos a TXT?

2. Si comprimes todos los archivos RTF a RAR o ZIP  cuanto pesan

Te lo pregunto porque la macro me funcion de TXT a Excel, no e podido hacerlo directamente desde RTF.

 

[rzamoras]

Si me haces el favor de enviarme la macro para  intentarlo te lo agradeceré enormemente... sirve que aprendo también un poco. 

[Janlui]

Abre un Modulo ( Alf + F11) y copia la macro, el Archivo TXT colocalo en la misma carpeta donde se encuentyre tu archivo excel. Si observas la macro, procesará el archivo 1.TXT

Sub opentxt()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Range("a1:b1000").ClearContents
    Dim myfile As Variant, cad As String, fila As Long
    ruta = ActiveWorkbook.Path
    ChDir ruta
    myfile = "1.txt"
    fname = Dir(myfile)
    If fname = "" Then
        MsgBox "No existe archivo en esta carpeta"
        Exit Sub
    End If
    
    Open myfile For Input As #1
    fila = 1
    Cells.Clear
    While Not EOF(1)
        Line Input #1, cad
        Cells(fila, 2) = cad
        fila = fila + 1
    Wend
    Close #1
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 

[rzamoras]

Buenos días, sigo intentando pasar las historias a excel, no he podido convertir los 12000 archivos en RTF a txt, con alguna macro se podrán hacer las conversiones de RTF a txt?, ya que con  word se pueden guardar como txt pero 1 archivo en 1 y no es viable para los 12000.

 

Gracias por los comentarios!!

[Janlui]

Daja lo checo si una Macro sobre de Word nos hace esa conversión y traslade a excel.