Microsoft Access-dan ma'lumotlarni eksport qilish juda oson - agar siz faqat bitta eksport faylini yaratmoqchi bo'lsangiz. Ammo so'rovni (yoki jadvalni) bir nechta eksport fayllariga bo'lish kerak bo'lganda nima qilasiz? Misol uchun, agar siz har oy mijozlar operatsiyalari ro'yxatini eksport qilishingiz kerak bo'lsa - har bir mijozning o'z eksport fayli bormi? Bu erda ushbu maqola sizga yordam berishi mumkin. 2, 10 yoki yuzlab turli eksport eksportini ishlab chiqarish kichik VBA kod parchasini ishga tushirish kabi oddiy bo'ladi va ish bir necha soat ichida qo'lda kesish/joylashtirishda emas, balki soniyalarda tugaydi. Shunday ekan, boshlaylik…
Yondashuv
Biz buni iloji boricha moslashuvchan va foydalanishga yaroqli bo'lishini xohlayotganimiz sababli, ushbu maqola uchun kod odatdagidan bir oz uzunroq bo'ladi, lekin nima uchun tez orada tushunasiz.
Birinchidan, nimaga erishmoqchi ekanligimizni aniqlaymiz:
Agar so'rov berilgan bo'lsa, belgilangan maydondagi qiymat har o'zgarganda yangi faylni chiqaring.
Qiyinchilik
Buning uchun biz so'rov natijalarini bosqichma-bosqich ko'rib chiqishimiz, joriy qatordagi tegishli maydonni oldingi qatordagi qiymat bilan taqqoslashimiz kerak – va agar ular boshqacha bo'lsa, yangi fayl yarating va u yerda so'rov natijalarini chiqarishni boshlang.
Bu nimaga mos EMAS
Yuqorida aytib o'tganimdek - ma'lumotlar bazasining qismlarini eksport qilishni xohlashingiz uchun juda ko'p sabablar bor, lekin uni zaxiralash/arxiv maqsadlari shakli sifatida ishlatish ulardan biri emas - albatta men yondashuv bilan emas. bu yerdan foydalanish - agar siz a'dan tiklanishga duch kelsangiz, qilmoqchi bo'lgan oxirgi narsa buzilgan mdb ma'lumotlar bazasi ko'plab eksportlarni qanday qilib birlashtirishni ishlab chiqmoqda!
Qaroringizmi?
Mushukning terisini olishning har doim ko'p usullari mavjud, bu usul faqat bittasi - lekin menimcha, juda yaxshi ishlaydigan usul. Avval biz so'rovni massivga o'qib chiqamiz, bu esa harakatlanishni osonlashtiradi. Keyin biz ushbu massivni aylanib chiqamiz va tegishli maydonda yangi qiymat topganimizni yoki topmaganimizni tekshiramiz. Agar bu yangi qiymat bo'lmasa, biz butun yozuvni yozayotgan joriy faylga chiqaramiz, agar u yangi bo'lsa, biz o'sha faylni yopamiz va yangisini boshlaymiz.
Va kod ...
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
Kod nima qilmoqda - asosiy fikrlar
Kodga ko'pgina muhim joylarda izohlar qo'shdim, ammo ta'kidlashga arziydigan bir nechta narsalar bor.
Birinchidan - biz kodni ikkita tartibga ajratdik. Birinchisi, joriy yozuv biz hozir ishlayotgan faylga yozilishi yoki yangi faylga yozilishi kerakligini tekshiradi. Ikkinchi tartib butun yozuv uchun ma'lumotlarni faylga chiqaradi. Koddagi takrorlanishni kamaytirish uchun shunday qilingan, aks holda siz ko'p joylarda bir xil aylanishni ko'rasiz.
Ikkinchidan – men biz ishlayotgan so‘rov haqida batafsil ma’lumot olish uchun “So‘rov ta’rifi” dan foydalanmoqdaman – agar siz buni jadvallar bilan ishlashga moslashtirmoqchi bo‘lsangiz, “So‘rov ta’rifi” ni ishlatib, uni almashtirishni ko‘rib chiqasiz. Buning o'rniga "Jadval ta'rifi".
Shu bilan birga, ishonchim komilki, bu siz qayta ko'rib chiqadigan va ko'p ishlatadigan bir oz koddir!
Muallif kirish:
Mitchell Pond - ma'lumotlarni qayta tiklash bo'yicha mutaxassis DataNumenMa'lumotlarni qayta tiklash texnologiyalari bo'yicha jahon yetakchisi bo'lgan , Inc ta'mirlash SQL Server ma'lumotlar va excel tiklash dasturiy mahsulotlar. Qo'shimcha ma'lumot olish uchun tashrif buyuring www.datanumen.com