Exportar información desde Microsoft Access es increíblemente fácil, asumiendo que solo desea producir un único archivo de exportación. Pero, ¿qué hace cuando necesita dividir una consulta (o tabla) en varios archivos de exportación? Por ejemplo, si necesita exportar una lista de transacciones de clientes cada mes, ¿cada cliente tiene su propio archivo de exportación? Ahí es donde este artículo puede ayudarte. Producir una exportación de 2, 10 o cien exportaciones diferentes será tan simple como ejecutar un pequeño fragmento de código VBA y el trabajo se terminará en segundos, no en horas de cortar / pegar manualmente. Vamos a empezar…
El enfoque
Como queremos que sea lo más flexible y utilizable posible, el código de este artículo será un poco más largo de lo habitual, pero verá por qué en breve.
En primer lugar, describamos lo que queremos poder lograr:
Dada una consulta, genera un archivo nuevo cada vez que cambia un valor en un campo específico.
El desafío
Para ello, necesitamos poder recorrer los resultados de la consulta, comparando el campo relevante de la fila actual con el valor de la fila anterior; si son diferentes, crear un nuevo archivo y empezar a mostrar allí los resultados de la consulta.
Para qué NO es adecuado
Como ya mencioné, hay muchas razones por las que querría exportar partes de su base de datos, pero usarla como una forma de respaldo / archivo no es una de ellas, ciertamente no con el enfoque que estoy usando aquí: lo último que desea hacer si se enfrenta a la recuperación de un base de datos mdb corrupta está trabajando en cómo volver a unir muchas exportaciones.
¿La solución?
Siempre hay muchas maneras de hacer las cosas, y esta es solo una, pero creo que funciona bastante bien. Primero, leeremos la consulta en un array para facilitar la navegación. Luego, recorreremos ese array, comprobando si hemos encontrado un nuevo valor en el campo correspondiente. Si no es un valor nuevo, guardaremos el registro completo en el archivo actual; si es nuevo, cerraremos ese archivo y crearemos uno nuevo.
Y el código ...
Sub DoExport(fieldName As String, queryName As String, filePath As String, Optional delim As Variant = vbTab)
Dim db As Database
Dim objRecordset As ADODB.Recordset
Dim qdf As QueryDef
Dim fldcounter, colno, numcols As Integer
Dim numrows, loopcount As Long
Dim data, fs, fwriter As Variant
Dim fldnames(), headerString As String
'get details of the query we'll be exporting
Set objRecordset = New ADODB.Recordset
Set db = CurrentDb
Set qdf = db.QueryDefs(queryName)
'load the query into a recordset so we can work with it
objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
'load the recordset into an array
data = objRecordset.GetRows
'close the recordset as we're done with it now
objRecordset.Close
'get details of the size of array, and position of the field we're checking for in that array
colno = qdf.Fields(fieldName).OrdinalPosition
numrows = UBound(data, 2)
numcols = UBound(data, 1)
'as we'll need to write out a header for each file - get the field names for that header
'and construct a header string
ReDim fldnames(numcols)
For fldcounter = 0 To qdf.Fields.Count - 1
fldnames(fldcounter) = qdf.Fields(fldcounter).Name
Next
headerString = Join(fldnames, delim)
'prepare the file scripting interface so we can create and write to our file(s)
Set fs = CreateObject("Scripting.FileSystemObject")
'loop through our array and output to the file
For loopcount = 0 To numrows
If loopcount > 0 Then
If data(colno, loopcount) <> data(colno, loopcount - 1) Then
If Not IsEmpty(fwriter) Then fwriter.Close
Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True)
fwriter.writeline headerString
writetoFile data, queryName, fwriter, loopcount, numcols
Else
writetoFile data, delim, fwriter, loopcount, numcols
End If
Else
Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True)
fwriter.writeline headerString
writetoFile data, delim, fwriter, loopcount, numcols
End If
Next
'tidy up after ourselves
fwriter.Close
Set fwriter = Nothing
Set objRecordset = Nothing
Set db = Nothing
Set qdf = Nothing
End Sub
'parameters are passed "by reference" to prevent moving potentially large objects around in memory
Sub writetoFile(ByRef data As Variant, ByVal delim As Variant, ByRef fwriter As Variant, ByVal counter As Long, ByVal numcols As Integer)
Dim loopcount As Integer
Dim outstr As String
For loopcount = 0 To numcols
outstr = outstr & data(loopcount, counter)
If loopcount < numcols Then outstr = outstr & delim
Next
fwriter.writeline outstr
End Sub
Qué está haciendo el código: puntos clave
He añadido comentarios al código en la mayoría de los puntos clave, pero aún hay un par de cosas que merece la pena destacar.
Primero, hemos dividido el código en dos rutinas. La primera verifica si el registro actual debe escribirse en el mismo archivo en el que estamos trabajando actualmente, o si debe escribirse en un archivo nuevo. La segunda rutina envía los detalles de todo el registro al archivo. Se ha hecho de esta manera para reducir la duplicación en el código; de lo contrario, vería el mismo bucle en muchos lugares.
En segundo lugar, estoy usando la "Definición de consulta" para obtener detalles sobre la consulta con la que estamos trabajando; si desea poder adaptar esto para que funcione con tablas, debería buscar cambiar eso para que use el " Definición de tabla ”en su lugar.
Dicho esto, estoy bastante seguro de que este es un fragmento de código al que volverá a consultar y usará mucho.
Introducción del autor:
Mitchell Pond es un experto en recuperación de datos en DataNumen, Inc., que es el líder mundial en tecnologías de recuperación de datos, incluyendo reparación SQL Server en y productos de software de recuperación de Excel. Para más información visite www.datanumen.com