Informācijas eksportēšana no Microsoft Access ir neticami vienkārša - pieņemot, ka vēlaties izveidot tikai vienu eksporta failu. Bet ko jūs darāt, ja vaicājums (vai tabula) jāsadala vairākos eksporta failos? Piemēram, ja jums katru mēnesi jāeksportē klientu darījumu saraksts - katram klientam ir savs eksporta fails? Šeit šis raksts var jums palīdzēt. 2, 10 vai simts dažādu eksportu izgatavošana būs tikpat vienkārša, kā palaist nelielu VBA koda fragmentu, un darbs tiks pabeigts dažu sekunžu laikā, nevis manuālas griešanas / ielīmēšanas stundu laikā. Tātad sāksim ...
Pieeja
Tā kā mēs vēlamies, lai tas būtu pēc iespējas elastīgāks un lietojamāks, šī raksta kods būs nedaudz garāks nekā parasti, taču drīz to redzēsit.
Pirmkārt - ieskicēsim, ko mēs vēlamies sasniegt:
Ņemot vērā vaicājumu, izvadiet jaunu failu katru reizi, kad mainās vērtība norādītajā laukā.
Izaicinājums
Lai to izdarītu, mums jāspēj pārskatīt vaicājuma rezultātus, salīdzinot pašreizējās rindas attiecīgo lauku ar iepriekšējās rindas vērtību - un, ja tie atšķiras, izveidojiet jaunu failu un start tur ievadiet vaicājuma rezultātus.
Kam tas NAV piemērots
Kā jau minēju - ir daudz iemeslu, kāpēc vēlaties eksportēt savas datubāzes daļas, taču tās izmantošana kā dublēšanas / arhīva veidus nav viena no tām - noteikti ne ar tādu pieeju, kāda man ir izmantojot šeit - pēdējā lieta, ko vēlaties darīt, ja saskaras ar atkopšanos no korumpēta mdb datu bāze strādā pie tā, kā atkal apvienot daudzus eksportus!
Atrisinājums?
Vienmēr ir daudz veidu, kā ādu kaķēt, tas ir tikai viens, bet es domāju, ka tas darbojas diezgan labi. Pirmkārt, mēs lasīsim vaicājumu masīvā, lai atvieglotu pārvietošanos. Tālāk mēs apskatīsim šo masīvu, pārbaudot, vai attiecīgajā laukā esam atraduši jaunu vērtību vai nē. Ja tā nav jauna vērtība, visu ierakstu mēs izvadām uz pašreizējo failu, kuru mēs rakstām, ja tas ir jauns, mēs aizvērsim šo failu un starta jauna.
Un kods ...
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
Ko dara kods - galvenie punkti
Esmu pievienojis komentārus kodam most galvenās vietas, taču joprojām ir pāris lietas, kuras ir vērts izcelt.
Pirmkārt - mēs esam sadalījuši kodu divās kārtībās. Pirmais pārbauda, vai pašreizējais ieraksts ir jāraksta tajā pašā failā, pie kura pašlaik strādājam, vai arī tas jāraksta jaunā failā. Otrā kārtība izvada failā visu ierakstu detaļas. Tas ir izdarīts šādā veidā, lai samazinātu koda dublēšanos, pretējā gadījumā jūs redzētu, ka tā pati cilpa notiek daudzās vietās.
Otrkārt - es izmantoju vaicājuma definīciju, lai iegūtu sīkāku informāciju par vaicājumu, pret kuru mēs strādājam. Ja vēlaties to pielāgot darbam ar tabulām, jūs to nomainītu, lai tajā izmantotu “ Tabulas definīcija ”vietā.
Pateicoties tam, es esmu diezgan pārliecināts, ka tas ir mazliet kods, uz kuru jūs atsauksieties un daudz lietosit!
Autora ievads:
Mičels Dīķis ir datu atkopšanas eksperts DataNumen, Inc., kas ir pasaules līderis datu atkopšanas tehnoloģiju, tostarp remonts SQL Server dati un Excel atkopšanas programmatūras produkti. Lai iegūtu vairāk informācijas, apmeklējiet vietni www.datanumen. Ar