L'exportation d'informations à partir de Microsoft Access est incroyablement facile - en supposant que vous ne souhaitiez produire qu'un seul fichier d'exportation. Mais que faites-vous lorsque vous devez diviser une requête (ou une table) en plusieurs fichiers d'exportation ? Par exemple, si vous avez besoin d'exporter une liste de transactions clients chaque mois – chaque client ayant son propre fichier d'exportation ? C'est là que cet article peut vous aider. Produire une exportation de 2, 10 ou une centaine d'exportations différentes sera aussi simple que d'exécuter un petit extrait de code VBA et le travail sera terminé en quelques secondes, et non en heures de couper/coller manuellement. Alors commençons…
L'approche
Parce que nous voulons que cela soit aussi flexible et utilisable que possible, le code de cet article va être un peu plus long que d'habitude, mais vous verrez pourquoi sous peu.
Tout d'abord, décrivons ce que nous voulons pouvoir réaliser :
Étant donné une requête, génère un nouveau fichier chaque fois qu'une valeur dans un champ spécifié change.
Le défi
Pour ce faire, nous devons pouvoir parcourir les résultats de la requête, en comparant le champ pertinent de la ligne actuelle à la valeur de la ligne précédente – et s'ils sont différents, créer un nouveau fichier et y enregistrer les résultats de la requête.
À quoi cela ne convient PAS
Comme je l'ai déjà mentionné - il existe de nombreuses raisons pour lesquelles vous voudriez exporter des parties de votre base de données, mais l'utiliser comme une forme de sauvegarde/archivage n'en fait pas partie - certainement pas avec l'approche que je suis en utilisant ici - la dernière chose que vous voulez faire si vous êtes confronté à la récupération d'un base de données mdb corrompue travaille sur la façon de recoller de nombreuses exportations !
La solution?
Il y a toujours plusieurs façons d'arriver à ses fins, celle-ci n'en est qu'une parmi d'autres, mais je pense qu'elle fonctionne plutôt bien. Tout d'abord, nous chargeons la requête dans un tableau pour faciliter la navigation. Ensuite, nous parcourons ce tableau pour vérifier si une nouvelle valeur a été trouvée dans le champ concerné. Si ce n'est pas le cas, nous enregistrons l'intégralité du contenu dans le fichier en cours d'écriture ; sinon, nous fermons ce fichier et en créons un nouveau.
Et le code...
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
Ce que fait le code - points clés
J'ai ajouté des commentaires au code à la plupart des endroits clés, mais il reste quelques points à souligner.
Tout d'abord, nous avons divisé le code en deux routines. La première vérifie si l'enregistrement actuel doit être écrit dans le même fichier sur lequel nous travaillons actuellement, ou s'il doit être écrit dans un nouveau fichier. La deuxième routine sort les détails de l'enregistrement entier dans le fichier. Cela a été fait de cette façon pour réduire la duplication dans le code, sinon vous verriez la même boucle se produire à de nombreux endroits.
Deuxièmement - j'utilise la "Définition de la requête" pour obtenir des détails sur la requête sur laquelle nous travaillons - si vous voulez pouvoir l'adapter pour qu'elle fonctionne avec des tables, vous devriez envisager de l'échanger pour qu'elle utilise le " Définition de table » à la place.
Cela dit, je suis assez confiant que c'est un peu de code auquel vous vous référerez et que vous utiliserez beaucoup !
Introduction de l'auteur:
Mitchell Pond est un expert en récupération de données dans DataNumen, Inc., qui est le leader mondial des technologies de récupération de données, y compris réparation SQL Server données, et des produits logiciels de récupération Excel. Pour plus d'informations, visitez www.datanumen.com