1个MS Access根据字段值查询多个Excel文件 [英] 1 MS Access Query to Multiple Excel Files Based on Field Value

问题描述

我有MS Access查询，我想根据一个字段值将其导出到多个Excel文件(.xlsx).用英语来说，我有一个查询，其中包含所有客户，但我想为每个客户创建一个excel文件，以便以后可以将每个客户记录通过电子邮件发送给他/她.

I have MS Access query which I want to export to multiple excel files (.xlsx) based on a field value. In English, I have a query which contains all my customers but I want to create an excel file for each customer so that I can email each customer records to him/her later on.

我在此链接代码中找到了 https://www.datanumen.com/blogs/export-results-query-multiple-files-access-vba/

I found a in this link code https://www.datanumen.com/blogs/export-results-query-multiple-files-access-vba/

只有一个问题，此代码才能正常工作.它将文件导出为文本文件，并且由于我对VBA的了解很少，因此无法转换为代码以导出excel文件.

This code works just fine with one issue. It exports the files as text files and couldn't convert to code to export excel files as I have little knowledge about VBA.

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

非常感谢您的帮助和支持.谢谢！

I really appreciate your help and support. Thanks!

推荐答案

考虑使用Access" DoCmd.TransferSpreadsheet 方法.无需生成文本文件，设置数组或标题循环.确保事先创建查询 [MyTempQuery] (可以是任何内容，因为SQL每次迭代都会被覆盖.还请确保转义客户名称中的任何单引号.

Consider using Access' DoCmd.TransferSpreadsheet method in a loop across a recordset of distinct customers. No need of generating text files, setting up arrays, or header loops. Be sure to create the query [MyTempQuery] in advance (which can be anything as its SQL is overwritten with each iteration. Also be sure to escape any single quotes in customer name.

Dim Db As DAO.Database, qdef AS DAO.QueryDef, rst As DAO.Recordset

Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT DISTINCT [CustomerName] FROM [QueryName]")

Do While Not rst.EOF
    Set qdef = db.QueryDefs("[MyTempQuery"])
    qdef.SQL = "SELECT * FROM [QueryName] WHERE Customer = '" & rst!CustomerName & "'"

    Set qdef = Nothing
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MyTempQuery", _
                  "C:\Path\To\Excel\Files\" & rst!CustomerName & ".xlsx", True
    rst.MoveNext
Loop

rst.Close
Set rst = Nothing: Set db = Nothing

这篇关于1个MS Access根据字段值查询多个Excel文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！