Como exportar os resultados de uma consulta para vários arquivos com o Access VBA

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 fazer 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 start exibindo os resultados da consulta lá.

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?

Sempre há muitas maneiras de esfolar um gato, esta é apenas uma – mas uma que funciona muito bem, eu acho. Em primeiro lugar, vamos ler a consulta em uma matriz para facilitar a movimentação. Em seguida, faremos um loop por esse array, verificando se encontramos um novo valor no campo relevante ou não. Se não for um novo valor, enviamos o registro inteiro para o arquivo atual que estamos gravando, se for novo, fechamos esse arquivo e starta novo.

E o código…

Sub DoExport(fieldName As String, queryName As String, filePath As String, opcional 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 'obter detalhes da consulta que estaremos exportando Set objRecordset = Novo ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs(queryName) 'carregar o consulta em um conjunto de registros para que possamos trabalhar com ele objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 'carrega o conjunto de registros em uma matriz data = objRecordset.GetRows 'fecha o conjunto de registros quando terminamos com ele agora objRecordset. Close 'obtém detalhes do tamanho da matriz e posição do campo que estamos verificando nessa matriz colno = qdf.Fields(fieldName).OrdinalPosition numrows = UBound(data, 2) numcols = UBound(data, 1) ' pois precisaremos escrever um cabeçalho para cada arquivo - obter os nomes dos campos para esse cabeçalho 'e construir uma string de cabeçalho ReDim fldnames(numcols) For fldcounter = 0 To qdf.Fields.Count - 1 fldnames(fldcounter) = qdf .Fields(fldcounter).Name Next headerString = Join(fldnames, delim) 'prepara a interface de script de arquivo para que possamos criar e escrever em nosso(s) arquivo(s) Set fs = CreateObject("Scripting.FileSystemObject") 'percorre nosso array e saída para o arquivo 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 'arrumamos depois de nós mesmos fwriter.Close Set fwriter = Nothing Set objRecordset = Nothing Set db = Nothing Set qdf = Nothing End Sub 'os parâmetros são passados ​​"por referência" para evitar a movimentação de objetos potencialmente grandes na memória 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

Eu adicionei comentários ao código em most lugares-chave, mas ainda há algumas coisas que valem 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