Exportar informações do Microsoft Access é incrivelmente fácil – supondo que você queira produzir apenas um único arquivo de exportação. Mas o que você faz quando precisa dividir uma consulta (ou tabela) em vários arquivos de exportação? Por exemplo, se você precisar exportar uma lista de transações de clientes todos os meses – cada cliente com seu próprio arquivo de exportação? É aí que este artigo pode te ajudar. Produzir uma exportação de 2, 10 ou cem exportações diferentes será tão simples quanto executar um pequeno trecho de código VBA e o trabalho será concluído em segundos, não em horas recortando/colando manualmente. Então vamos começar…
A abordagem
Como queremos que seja o mais flexível e utilizável possível, o código deste artigo será um pouco mais longo do que o normal, mas você verá o motivo em breve.
Em primeiro lugar - vamos delinear o que queremos ser capazes de alcançar:
Dada uma consulta, gere um novo arquivo sempre que um valor em um campo especificado for alterado.
O desafio
Para isso, precisamos ser capazes de percorrer os resultados da consulta, comparando o campo relevante na linha atual com o valor na linha anterior – e, se forem diferentes, criar um novo arquivo e começar a exibir os resultados da consulta nele.
Para que isso NÃO é adequado
Como já mencionei - há muitos motivos pelos quais você deseja exportar partes de seu banco de dados, mas usá-lo como uma forma de backup/arquivamento não é um deles - certamente não com a abordagem que estou usando aqui - a última coisa que você quer fazer se estiver se recuperando de um banco de dados mdb corrompido está trabalhando em como juntar várias exportações!
A solução?
Existem sempre várias maneiras de se fazer algo, esta é apenas uma delas – mas uma que funciona muito bem, eu acho. Primeiro, vamos ler a consulta e armazená-la em um array para facilitar a navegação. Em seguida, vamos percorrer esse array, verificando se encontramos um novo valor no campo relevante. Se não for um novo valor, gravamos o registro inteiro no arquivo atual; se for, fechamos o arquivo e começamos um novo.
E o 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
O que o código está fazendo – pontos-chave
Adicionei comentários ao código na maioria dos pontos principais, mas ainda há algumas coisas que vale a pena destacar.
Primeiro – dividimos o código em duas rotinas. A primeira verifica se o registro atual deve ser gravado no mesmo arquivo em que estamos trabalhando ou se deve ser gravado em um novo arquivo. A segunda rotina gera os detalhes de todo o registro para o arquivo. Isso foi feito dessa maneira para reduzir a duplicação no código, caso contrário, você veria o mesmo loop ocorrendo em muitos lugares.
Segundo – estou usando a “Definição de consulta” para obter detalhes sobre a consulta com a qual estamos trabalhando – se você quiser adaptar isso para trabalhar com tabelas, procure trocá-la para que use o “ Definição de tabela” em vez disso.
Com isso dito, estou bastante confiante de que este é um código ao qual você se referirá e usará muito!
Introdução do autor:
Mitchell Pond é um especialista em recuperação de dados em DataNumen, Inc., líder mundial em tecnologias de recuperação de dados, incluindo reparar SQL Server dados, e produtos de software de recuperação do Excel. Para mais informações visite www.datanumen.com