Eksportimi i informacionit nga Microsoft Access është tepër i lehtë – duke supozuar se dëshironi të prodhoni vetëm një skedar të vetëm eksporti. Por çfarë bëni kur ju duhet të ndani një pyetje (ose tabelë) në skedarë të shumtë eksportues? Për shembull, nëse ju duhet të eksportoni një listë të transaksioneve të klientëve çdo muaj - secili klient ka skedarin e tij të eksportit? Këtu mund t'ju ndihmojë ky artikull. Prodhimi i një eksporti prej 2, 10 ose njëqind eksportesh të ndryshme do të jetë po aq i thjeshtë sa ekzekutimi i një fragmenti të vogël kodi VBA dhe puna do të përfundojë në sekonda, jo për orë të tëra prerje/ngjitje manuale. Pra le të fillojmë…
Qasja
Për shkak se ne duam që kjo të jetë sa më fleksibël dhe e përdorshme, kodi për këtë artikull do të jetë pak më i gjatë se zakonisht, por do ta shihni së shpejti pse.
Së pari - le të përshkruajmë atë që duam të arrijmë:
Duke pasur parasysh një pyetje, nxirrni një skedar të ri sa herë që ndryshon një vlerë në një fushë të caktuar.
Sfida
Për ta bërë këtë, duhet të jemi në gjendje të shqyrtojmë hap pas hapi rezultatet e pyetjes, duke krahasuar fushën përkatëse në rreshtin aktual me vlerën në rreshtin e mëparshëm - dhe nëse ato janë të ndryshme, krijoni një skedar të ri dhe filloni të nxirrni rezultatet e pyetjes atje.
Për çfarë kjo NUK është e përshtatshme
Siç e kam përmendur tashmë – ka shumë arsye pse dëshironi të eksportoni pjesë të bazës së të dhënave tuaja, por përdorimi i saj si një formë e qëllimeve rezervë/arkivimi nuk është një prej tyre – sigurisht jo me qasjen që unë jam duke përdorur këtu – gjëja e fundit që dëshironi të bëni nëse jeni përballur me rikuperimin nga a Baza e të dhënave mdb e korruptuar po punon se si të bashkojë shumë eksporte përsëri së bashku!
Zgjidhja?
Gjithmonë ka shumë mënyra për të hequr lëkurën e një maceje, kjo është vetëm një mënyrë - por mendoj se funksionon mjaft mirë. Së pari do ta lexojmë pyetjen në një varg për ta bërë lëvizjen më të lehtë. Më pas do të kalojmë nëpër atë varg, duke kontrolluar nëse kemi gjetur një vlerë të re në fushën përkatëse apo jo. Nëse nuk është një vlerë e re, e nxjerrim të gjithë rekordin në skedarin aktual që po shkruajmë, nëse është i ri, do ta mbyllim atë skedar dhe do të hapim një të ri.
Dhe kodi…
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
Çfarë po bën kodi – pikat kryesore
Kam shtuar komente në kod në shumicën e vendeve kyçe, por ka ende disa gjëra që ia vlen të theksohen.
Së pari - ne e kemi ndarë kodin në dy rutina. E para kontrollon nëse regjistrimi aktual duhet të shkruhet në të njëjtin skedar që po punojmë aktualisht, ose nëse duhet të shkruhet në një skedar të ri. Rutina e dytë nxjerr detajet për të gjithë regjistrimin në skedar. Është bërë në këtë mënyrë për të reduktuar dyfishimin në kod, përndryshe do të shihnit të njëjtin looping që po ndodh në shumë vende.
Së dyti - Unë jam duke përdorur "Përkufizimin e pyetjes" për të marrë detaje rreth pyetjes me të cilën po punojmë - nëse dëshironi të jeni në gjendje ta përshtatni këtë për të punuar me tabelat, do të shikoni ta ndërroni atë në mënyrë që të përdorte " Përkufizimi i tabelës” në vend të kësaj.
Me këtë u tha, unë jam shumë i sigurt se ky është pak kod të cilit do t'i referoheni dhe do ta përdorni shumë!
Hyrje e autorit:
Mitchell Pond është një ekspert i rikuperimit të të dhënave në DataNumen, Inc., e cila është lider botëror në teknologjitë e rikuperimit të të dhënave, duke përfshirë riparim SQL Server të dhëna dhe produkte softuerike të rimëkëmbjes excel. Për më shumë informacion vizitoni www.datanumen.com