Mengekspor informasi dari Microsoft Access sangatlah mudah - dengan asumsi Anda hanya ingin menghasilkan satu file ekspor. Tapi apa yang Anda lakukan saat Anda perlu membagi kueri (atau tabel) menjadi beberapa file ekspor? Misalnya, jika Anda perlu mengekspor daftar transaksi pelanggan setiap bulan - setiap pelanggan memiliki file ekspor mereka sendiri? Di situlah artikel ini dapat membantu Anda. Menghasilkan ekspor 2, 10, atau seratus ekspor yang berbeda akan semudah menjalankan sedikit cuplikan kode VBA dan pekerjaan akan selesai dalam hitungan detik, bukan berjam-jam memotong / menempel secara manual. Jadi mari kita mulai…
Pendekatan
Karena kami ingin ini menjadi sefleksibel dan dapat digunakan semaksimal mungkin, kode untuk artikel ini akan menjadi sedikit lebih panjang dari biasanya, tetapi Anda akan segera mengetahui alasannya.
Pertama - mari kita jelaskan apa yang ingin kita capai:
Dengan adanya kueri, keluarkan file baru setiap kali nilai dalam bidang tertentu berubah.
Tantangan
Untuk melakukan ini, kita perlu dapat menelusuri hasil kueri, membandingkan kolom yang relevan di baris saat ini dengan nilai di baris sebelumnya – dan jika berbeda, buat file baru dan mulai menampilkan hasil kueri di sana.
Ini TIDAK cocok untuk apa
Seperti yang telah saya sebutkan - ada banyak alasan mengapa Anda ingin mengekspor bagian dari database Anda, tetapi menggunakannya sebagai bentuk tujuan pencadangan / pengarsipan bukanlah salah satunya - tentu saja tidak dengan pendekatan saya. gunakan di sini - hal terakhir yang ingin Anda lakukan jika Anda dihadapkan pada pemulihan dari file database mdb yang rusak sedang mencari cara untuk menyatukan banyak ekspor kembali!
Solusi?
Selalu ada banyak cara untuk menyelesaikan suatu masalah, cara ini hanyalah salah satunya – tetapi menurut saya cara ini cukup efektif. Pertama, kita akan membaca kueri ke dalam sebuah array agar lebih mudah dipindahkan. Selanjutnya, kita akan melakukan perulangan melalui array tersebut, memeriksa apakah kita telah menemukan nilai baru di bidang yang relevan atau tidak. Jika bukan nilai baru, kita akan mengeluarkan seluruh catatan ke file yang sedang kita tulis, jika itu nilai baru, kita akan menutup file tersebut dan memulai file baru.
Dan kodenya…
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
Apa yang dilakukan kode itu - poin-poin penting
Saya telah menambahkan komentar pada kode di sebagian besar tempat penting, tetapi masih ada beberapa hal yang perlu disoroti.
Pertama - kami membagi kode menjadi dua rutinitas. Pemeriksaan pertama apakah rekaman saat ini harus ditulis ke file yang sama yang sedang kami kerjakan, atau apakah itu harus ditulis ke file baru. Rutin kedua mengeluarkan detail untuk seluruh record ke file. Ini telah dilakukan dengan cara ini untuk mengurangi duplikasi dalam kode, jika tidak, Anda akan melihat perulangan yang sama terjadi di banyak tempat.
Kedua - Saya menggunakan "Definisi Kueri" untuk mendapatkan detail tentang kueri yang sedang kami tangani - jika Anda ingin dapat menyesuaikan ini untuk bekerja dengan tabel, Anda akan melihat menukar sehingga menggunakan " Definisi Tabel ”sebagai gantinya.
Karena itu, saya cukup yakin ini adalah sedikit kode yang akan Anda rujuk kembali dan banyak digunakan!
Pengantar Penulis:
Mitchell Pond adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk memperbaiki SQL Server data dan unggul dalam produk perangkat lunak pemulihan. Untuk informasi lebih lanjut kunjungi www.datanumen.com