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”-ს, რათა მივიღო დეტალები იმ მოთხოვნის შესახებ, რომლის წინააღმდეგაც ჩვენ ვმუშაობთ – თუ გსურთ ამის ადაპტაცია ცხრილებთან მუშაობისთვის, თქვენ უნდა შეხედოთ მის შეცვლას ისე, რომ გამოიყენოს ” მაგიდის განმარტება“ ნაცვლად.
ამასთან, დარწმუნებული ვარ, რომ ეს არის ცოტა კოდი, რომელსაც კვლავ მიმართავთ და ბევრს გამოიყენებთ!
ავტორი შესავალი:
მიტჩელ პონდი არის მონაცემთა აღდგენის ექსპერტი DataNumen, Inc., რომელიც მსოფლიო ლიდერია მონაცემთა აღდგენის ტექნოლოგიებში, მათ შორის სარემონტო SQL Server მონაცემები და Excel-ის აღდგენის პროგრამული პროდუქტები. დამატებითი ინფორმაციისთვის ეწვიეთ www.datanumen. ერთად