Η εξαγωγή πληροφοριών από τη Microsoft Access είναι απίστευτα εύκολη - υποθέτοντας ότι θέλετε να δημιουργήσετε μόνο ένα αρχείο εξαγωγής. Αλλά τι κάνετε όταν πρέπει να χωρίσετε ένα ερώτημα (ή πίνακα) σε πολλά αρχεία εξαγωγής; Για παράδειγμα, εάν πρέπει να εξάγετε μια λίστα συναλλαγών πελατών κάθε μήνα - κάθε πελάτης έχει το δικό του αρχείο εξαγωγής; Εκεί μπορεί να σας βοηθήσει αυτό το άρθρο. Η παραγωγή μιας εξαγωγής 2, 10 ή εκατό διαφορετικών εξαγωγών θα είναι τόσο απλή όσο η εκτέλεση ενός μικρού αποσπάσματος κώδικα VBA και η εργασία θα ολοκληρωθεί σε δευτερόλεπτα και όχι σε ώρες μη αυτόματης κοπής / επικόλλησης. Ας ξεκινήσουμε λοιπόν…
Η προσέγγιση
Επειδή θέλουμε αυτό να είναι όσο το δυνατόν πιο ευέλικτο και χρησιμοποιήσιμο, ο κώδικας για αυτό το άρθρο θα είναι λίγο μεγαλύτερος από το συνηθισμένο, αλλά θα δείτε γιατί σύντομα.
Πρώτον - ας περιγράψουμε τι θέλουμε να επιτύχουμε:
Με δεδομένο ένα ερώτημα, εξάγετε ένα νέο αρχείο κάθε φορά που αλλάζει μια τιμή σε ένα καθορισμένο πεδίο.
Η πρόκληση
Για να το κάνουμε αυτό, πρέπει να μπορούμε να εξετάσουμε βήμα προς βήμα τα αποτελέσματα του ερωτήματος, συγκρίνοντας το σχετικό πεδίο στην τρέχουσα γραμμή με την τιμή στην προηγούμενη γραμμή – και, εάν είναι διαφορετικά, να δημιουργήσουμε ένα νέο αρχείο και να ξεκινήσουμε την εξαγωγή των αποτελεσμάτων του ερωτήματος από εκεί.
Σε τι ΔΕΝ είναι κατάλληλο για
Όπως έχω ήδη αναφέρει - υπάρχουν πολλοί λόγοι για τους οποίους θα θέλατε να εξάγετε τμήματα της βάσης δεδομένων σας, αλλά η χρήση του ως μορφή δημιουργίας αντιγράφων ασφαλείας / αρχειοθέτησης δεν είναι ένας από αυτούς - σίγουρα όχι με την προσέγγιση που είμαι χρησιμοποιώντας εδώ - το τελευταίο πράγμα που θέλετε να κάνετε αν είστε αντιμέτωποι με την ανάκαμψη από ένα κατεστραμμένη βάση δεδομένων mdb δουλεύει πώς να συρράψει πολλές εξαγωγές μαζί!
Η λύση?
Υπάρχουν πάντα πολλοί τρόποι για να γδάρουμε μια γάτα, αυτός ο τρόπος είναι μόνο ένας - αλλά νομίζω ότι λειτουργεί αρκετά καλά. Αρχικά, θα διαβάσουμε το ερώτημα σε έναν πίνακα για να διευκολύνουμε την μετακίνηση. Στη συνέχεια, θα επανέλθουμε σε αυτόν τον πίνακα, ελέγχοντας αν έχουμε βρει μια νέα τιμή στο σχετικό πεδίο ή όχι. Εάν δεν είναι νέα τιμή, εξάγουμε ολόκληρη την εγγραφή στο τρέχον αρχείο που γράφουμε, εάν είναι νέα, θα κλείσουμε αυτό το αρχείο και θα ξεκινήσουμε ένα νέο.
Και ο κωδικός…
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
Τι κάνει ο κώδικας - βασικά σημεία
Έχω προσθέσει σχόλια στον κώδικα στα περισσότερα βασικά σημεία, αλλά υπάρχουν ακόμα μερικά πράγματα που αξίζει να επισημανθούν.
Πρώτα - χωρίσαμε τον κώδικα σε δύο ρουτίνες. Ο πρώτος ελέγχει εάν η τρέχουσα εγγραφή πρέπει να γραφτεί στο ίδιο αρχείο που επεξεργαζόμαστε αυτήν τη στιγμή ή εάν πρέπει να γραφτεί σε ένα νέο αρχείο. Η δεύτερη ρουτίνα εξάγει τις λεπτομέρειες για ολόκληρη την εγγραφή στο αρχείο. Έχει γίνει με αυτόν τον τρόπο για να μειωθεί η επανάληψη στον κώδικα, αλλιώς θα δείτε το ίδιο βρόχο να λαμβάνει χώρα σε πολλά μέρη.
Δεύτερον - Χρησιμοποιώ το "Query Definition" για να λάβω λεπτομέρειες σχετικά με το ερώτημα που αντιμετωπίζουμε - αν θέλετε να μπορείτε να το προσαρμόσετε ώστε να λειτουργεί με πίνακες, θα κοιτάζατε να το αλλάζετε έτσι ώστε να χρησιμοποιεί το " Αντίθετα, ο ορισμός του πίνακα.
Με αυτό είπε, είμαι πολύ σίγουρος ότι πρόκειται για λίγο κώδικα στον οποίο θα αναφερθείτε και θα χρησιμοποιήσετε πολύ!
Εισαγωγή συγγραφέα:
Ο Mitchell Pond είναι ειδικός στην ανάκτηση δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων επισκευή SQL Server ημερομηνία και υπερέχουν προϊόντα λογισμικού ανάκτησης. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com