Exportar varias tablas a un mismo txt
Quiero exportar varias tablas de Access a un mismo txt por medio de VBA pero no se como, las siguientes son las limitaciones, empiezo al final a manejar código VBA y no sé como se hacen algunas cosas, todas las tablas tienen un ancho fijo distinto y campos variables por lo que no he podido pasarlas a una misma tabla y después exportar, la tabla 1 va al principio, la tabla 2 en medio y la tabla 3 al final, la tabla 2 puede tener de 2 registros o líneas hasta 8 millones por lo que hacer varios txt y luego unirlos con ms-2 consume mucho tiempo.
1 Respuesta
Puedes usar este código, que se lo puedes asignar a un botón, por ejemplo:
Dim miTXT As String
Dim miFila As String
Dim rst As DAO.Recordset
Dim i As Integer
'Ruta al fichero (si no existe lo crea, si existe lo sobreescribe)
miTXT = Application.CurrentProject.Path & "\Datos.txt"
'Abres el recordset
Open miTXT For Output As #1
'Primera tabla
Set rst = CurrentDb.OpenRecordset("Tabla1")
If rst.RecordCount <> o Then 'Si tiene registros
Do Until rst.EOF
'recorres todos los campos y los delimitas con TAB
For i = 0 To rst.Fields.Count - 1
miFila = miFila & rst(i) & vbTab
Next
'Pasas el registro al archivo y reseteas miFila
Print #1, miFila
miFila = ""
rst.MoveNext
Loop
End If
'Inserto una linea en blanco para separar
Print #1, ""
'Segunda tabla
Set rst = CurrentDb.OpenRecordset("Tabla3")
If rst.RecordCount <> o Then 'Si tiene registros
Do Until rst.EOF
'recorres todos los campos y los delimitas con TAB
For i = 0 To rst.Fields.Count - 1
miFila = miFila & rst(i) & vbTab
Next
'Pasas el registro al archivo y reseteas miFila
Print #1, miFila
miFila = ""
rst.MoveNext
Loop
End If
'Inserto una linea en blanco para separar
Print #1, ""
'Tercera tabla
Set rst = CurrentDb.OpenRecordset("TDatos")
If rst.RecordCount <> o Then 'Si tiene registros
Do Until rst.EOF
'recorres todos los campos y los delimitas con TAB
For i = 0 To rst.Fields.Count - 1
miFila = miFila & rst(i) & vbTab
Next
'Pasas el registro al archivo y reseteas miFila
Print #1, miFila
miFila = ""
rst.MoveNext
Loop
End If
'Cierras el archivo y el recordset
rst.Close
Set rst = Nothing
Close #1Se podría "optimizar" para pasarle las tablas como parámetro y sustituir las lineas que se repiten para cada tabla por un ciclo que lo haga para cada tabla, pero a "efectos didácticos", así lo ves menos enrevesado.
Un saludo.
¡Gracias!, lo aplicó y te aviso como quedó
Se me pasó comentarte dos cambios que has de hacer en el código:
La linea: miTXT=Application.CurrentProject.Path & "\Datos.txt" debes cambiarla por la ruta y nombre del archivo que quieras (con esa linea te crea un archivo Datos.txt en la misma carpeta que tengas la BD)
En las lineas: Set rst=CurrentDb.OpenRecordset("xxxx") tienes que cambiar lo que va entre los paréntesis por los nombres de tus tablas.
Gracias, ya realice los cambios, pero tengo el problema de que no me respeta la longitud del campo, como en una exportación de ancho fijo y necesito que me respete la longitud de los campos aun y cuando sean blancos, espero me puedas ayudar y reitero mi gratitud
Lo único que se me ocurre es meterle espacios en blanco al contenido de cada campo de cada tabla hasta que se complete el tamaño de cada campo.
Copia este código en un módulo nuevo de tu BD:
Public Sub exportaTablasAnchoFijo(ParamArray lasTablas()) Dim miTXT As String Dim miFila As String Dim rst As DAO.Recordset Dim fld As DAO.Field Dim prop As Property Dim i As Integer Dim j As Integer Dim elAncho As Integer Dim campoLargo As String 'Ruta al fichero (si no existe lo crea, si existe lo sobreescribe) miTXT = Application.CurrentProject.Path & "\Datos.txt" 'Abres el archivo Open miTXT For Output As #1 'Bucle para recorrer las tablas For j = 0 To UBound(lasTablas) Set rst = CurrentDb.OpenRecordset(lasTablas(j)) If rst.RecordCount <> o Then 'Si tiene registros Do Until rst.EOF 'recorres todos los campos y los delimitas con TAB For i = 0 To rst.Fields.Count - 1 Set fld = rst.Fields(i) For Each prop In fld.Properties On Error Resume Next If prop.Name = "Size" Then elAncho = prop Exit For End If On Error GoTo 0 Next prop If Nz(Len(rst(i)), 0) < elAncho Then campoLargo = String(elAncho - Nz(Len(rst(i)), 0), " ") & rst(i) Else campoLargo = Nz(rst(i), " ") End If miFila = miFila & campoLargo & vbTab Next i 'Pasas el registro al archivo y reseteas miFila Print #1, miFila miFila = "" rst.MoveNext Loop End If 'Inserto una linea en blanco para separar Print #1, "" Next j 'Cierras el archivo y el recordset rst.Close Set rst = Nothing Close #1 End Sub
Y en el botón que ejecuta el proceso, éste (con los nombres de las tablas [o consultas] que quieres exportar):
ExportaTablasAnchoFijo "TDatos4", "TDatos2", "TDatos3"
Con esto creo que tienes lo que buscas.
Te dejo el archivo en el que lo probé, para que lo veas: http://filebig.net/files/TuStBN9eyF
Un saludo.
