Xuất thông tin từ Microsoft Access cực kỳ dễ dàng – giả sử bạn chỉ muốn tạo một tệp xuất duy nhất. Nhưng bạn sẽ làm gì khi cần chia truy vấn (hoặc bảng) thành nhiều tệp xuất? Ví dụ: nếu bạn cần xuất danh sách giao dịch khách hàng mỗi tháng – mỗi khách hàng có tệp xuất riêng? Đó là nơi bài viết này có thể giúp bạn. Việc xuất 2, 10 hoặc hàng trăm bản xuất khác nhau sẽ đơn giản như chạy một đoạn mã VBA nhỏ và công việc sẽ hoàn thành sau vài giây chứ không phải hàng giờ cắt/dán thủ công. Vậy hãy bắt đầu…
Cách tiếp cận
Bởi vì chúng tôi muốn điều này trở nên linh hoạt và có thể sử dụng được hết mức có thể, mã cho bài viết này sẽ dài hơn bình thường một chút, nhưng bạn sẽ sớm hiểu lý do tại sao.
Đầu tiên - hãy phác thảo những gì chúng ta muốn có thể đạt được:
Đưa ra một truy vấn, xuất một tệp mới mỗi khi một giá trị trong một trường được chỉ định thay đổi.
Các thách thức
Để thực hiện điều này, chúng ta cần có khả năng duyệt qua kết quả truy vấn, so sánh trường liên quan trong hàng hiện tại với giá trị trong hàng trước đó – và nếu chúng khác nhau, hãy tạo một tệp mới và bắt đầu xuất kết quả truy vấn vào đó.
Cái này KHÔNG phù hợp với cái gì
Như tôi đã đề cập – có rất nhiều lý do khiến bạn muốn xuất các phần cơ sở dữ liệu của mình, nhưng sử dụng nó như một dạng mục đích sao lưu/lưu trữ không phải là một trong số đó – chắc chắn không phải với cách tiếp cận mà tôi đang áp dụng. sử dụng ở đây – điều cuối cùng bạn muốn làm nếu phải đối mặt với việc khôi phục từ một cơ sở dữ liệu mdb bị hỏng đang tìm cách ghép nhiều mặt hàng xuất khẩu lại với nhau!
Giải pháp?
Luôn có nhiều cách để giải quyết một vấn đề, cách này chỉ là một trong số đó – nhưng tôi nghĩ nó hoạt động khá tốt. Đầu tiên, chúng ta sẽ đọc truy vấn vào một mảng để dễ dàng thao tác hơn. Tiếp theo, chúng ta sẽ lặp qua mảng đó, kiểm tra xem có tìm thấy giá trị mới trong trường liên quan hay không. Nếu không phải là giá trị mới, chúng ta sẽ xuất toàn bộ bản ghi vào tệp hiện tại đang ghi; nếu là giá trị mới, chúng ta sẽ đóng tệp đó và bắt đầu một tệp mới.
Và mã…
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
Mã đang làm gì – các điểm chính
Tôi đã thêm chú thích vào mã ở hầu hết các vị trí quan trọng, nhưng vẫn còn một vài điểm đáng lưu ý.
Đầu tiên - chúng tôi đã chia mã thành hai thói quen. Đầu tiên kiểm tra xem bản ghi hiện tại có nên được ghi vào cùng một tệp mà chúng tôi hiện đang làm việc hay liệu nó có nên được ghi vào một tệp mới hay không. Quy trình thứ hai xuất chi tiết cho toàn bộ bản ghi vào tệp. Nó đã được thực hiện theo cách này để cắt giảm sự trùng lặp trong mã, nếu không, bạn sẽ thấy cùng một vòng lặp diễn ra ở nhiều nơi.
Thứ hai – Tôi đang sử dụng “Định nghĩa truy vấn” để biết chi tiết về truy vấn mà chúng tôi đang xử lý - nếu bạn muốn có thể điều chỉnh truy vấn này để làm việc với các bảng, bạn nên xem xét hoán đổi truy vấn đó để nó sử dụng “ Định nghĩa bảng” thay thế.
Như đã nói, tôi khá tự tin rằng đây là một đoạn mã mà bạn sẽ tham khảo lại và sử dụng rất nhiều!
Giới thiệu tác giả:
Mitchell Pond là một chuyên gia phục hồi dữ liệu trong DataNumen, Inc., công ty hàng đầu thế giới về công nghệ khôi phục dữ liệu, bao gồm sửa SQL Server dữ liệu và các sản phẩm phần mềm phục hồi excel. Để biết thêm thông tin, hãy truy cập www.datanumennăm