Excel 控制在msaccess中将查询导出到哪个电子表格

我有一个查询，它会根据我设置的条件进行更改。将查询导出到excel电子表格后，查询结果将发生更改

这是查询工作原理的一个示例

类别=A、B、C

过滤器=D，E，F

其结果如下：

AxF

将其导出到电子表格后，我将再次运行相同的查询，但使用不同的参数集，例如：

CxD

我没有将结果发送到不同的查询，而是在vba中重写输出查询的sql，这样做是有原因的，但在导出返回的查询时，出于某种原因，它将执行以下操作之一：

覆盖excel中已有的数据

与excel中已有的数据合并

删除电子表格中的所有数据

有没有办法控制查询输出到哪个电子表格

我希望它的工作方式如下：

工作表=outqueryCATEGORYxFILTER 表1=outqueryAxF sheet2=outqueryCxD sheet3=outqueryBxE 因为每次调用查询时，查询的条件都会改变，所以发布我的查询代码将毫无意义

但我要举一个更好的例子：

设x表示第一个参数 让y表示第二个参数 让A代表第一类 设B代表第二类

从*中选择*其中A=x和B=y

假设我有一张下面的表格，这只是一个例子

将该表称为EXTABLE

姓名----日期----年龄----性别----国家

阿曼达---07/04---21----女----美国

MAX---09/17---30----男-----美国

莎拉----05/03---18----女----英国

马克斯----09/17---21----男性----英格兰

亚历克西斯---10/25---37----女----法国

皮埃尔---07/04---30----男-----法国

我的问题有时可能类似于：

从EXTABLE中选择*，其中年龄=21，性别=男性

但下次我调用查询时，它可能是：

从EXTABLE中选择*，其中COUNTRY=ENGLAND，BDAY=05/17

---

通过vba更改sql的原因不仅是因为条件的参数在更改，而且参数所应用到的类别也在更改。我仍然相信，您可以通过参数查询来执行此操作，尽管我必须考虑一下

为了得到一些你可以使用的东西，我提出了这个抱歉，目前有多个查询：

首先，我将两个查询创建为存储查询：

Public Sub ProcessQuery()

    Dim oXL As Object
    Dim oWrkBk As Object
    Dim oWrkSht As Object

    Set oXL = CreateXL
    Set oWrkBk = oXL.Workbooks.Add(-4167) 'xlWBATWorksheet - creates a workbook with 1 sheet.
    Set oWrkSht = oWrkBk.Worksheets(1)

    Export_To_XL "AgeGender", oWrkSht.Range("A1"), "Person_Age", 47, "Person_Gender", "Female"

    Set oWrkSht = oWrkBk.Worksheets.Add 'This will now have a reference of your new sheet.
    Export_To_XL "CountryBday", oWrkSht.Range("A1"), "Person_Country", "England", "Person_Bday", #5/3/1971#

End Sub

年龄性别

国家日

这是导出两个查询的主要过程：

Public Sub ProcessQuery()

    Dim oXL As Object
    Dim oWrkBk As Object
    Dim oWrkSht As Object

    Set oXL = CreateXL
    Set oWrkBk = oXL.Workbooks.Add(-4167) 'xlWBATWorksheet - creates a workbook with 1 sheet.
    Set oWrkSht = oWrkBk.Worksheets(1)

    Export_To_XL "AgeGender", oWrkSht.Range("A1"), "Person_Age", 47, "Person_Gender", "Female"

    Set oWrkSht = oWrkBk.Worksheets.Add 'This will now have a reference of your new sheet.
    Export_To_XL "CountryBday", oWrkSht.Range("A1"), "Person_Country", "England", "Person_Bday", #5/3/1971#

End Sub

用于处理查询并将其导出到Excel的代码。ParamArray必须采用两个参数集—参数名称及其值

Public Sub Export_To_XL(sQueryName As String, PasteRange As Object, ParamArray Params())

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field
    Dim pElement As Long

    On Error GoTo ERR_HANDLE

    Set db = CurrentDb
    Set qdf = db.QueryDefs(sQueryName)
    With qdf
        For pElement = LBound(Params) To UBound(Params) Step 2
            .Parameters(Params(pElement)) = Params(pElement + 1)
        Next
    End With
    Set rst = qdf.OpenRecordset

    With rst
        If Not (.BOF And .EOF) Then

            For Each fld In rst.Fields
                PasteRange.offset(, fld.OrdinalPosition) = fld.Name
            Next fld
            PasteRange.Resize(, rst.Fields.Count).Font.Bold = True
            PasteRange.offset(1).CopyFromRecordset rst
            PasteRange.Parent.Columns.Autofit

        End If
    End With

EXIT_PROC:

    Set rst = Nothing

        On Error GoTo 0
        Exit Sub

ERR_HANDLE:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure Export_To_XL."
            Resume EXIT_PROC
    End Select

End Sub  

您将需要代码来创建Excel实例：

Public Function CreateXL(Optional bVisible As Boolean = True) As Object

    Dim oTmpXL As Object

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpXL = CreateObject("Excel.Application")
    End If

    oTmpXL.Visible = bVisible
    Set CreateXL = oTmpXL

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateXL."
            Err.Clear
    End Select

End Function  

---

不知道为什么要在VBA中重写SQL-使用参数肯定更好？还有，你们是如何出口的？传输电子表格，从记录集复制？我们能看看你的代码吗？我没有上传代码的原因是因为我试图让这成为一个更一般的问题。除此之外，我重写sql的原因是，我对它进行了设置，这样我就不必为每一个可能的组合创建查询，大约有100个，并且为每一个组合创建查询是不切实际的，特别是考虑到将来可能会有更多的可能组合。除此之外，这一切都是通过vba表单完成的，以允许用户界面。但我没有尝试的是copyfromrecordset，我将尝试一下。

Public Function CreateXL(Optional bVisible As Boolean = True) As Object

    Dim oTmpXL As Object

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpXL = CreateObject("Excel.Application")
    End If

    oTmpXL.Visible = bVisible
    Set CreateXL = oTmpXL

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateXL."
            Err.Clear
    End Select

End Function  

PARAMETERS  Person_Name Text(255), Person_Bday DateTime, Person_Age Long, 
            Person_Gender Text(255), Person_Country Text(255);
SELECT      *
FROM        EXTABLE
WHERE       IIF(ISNULL(Person_Name),TRUE,sName = Person_Name) AND
            IIF(ISNULL(Person_Bday),TRUE,Bday = Person_Bday) AND
            IIF(ISNULL(Person_Age),TRUE,Age = Person_Age) AND
            IIF(ISNULL(Person_Gender),TRUE,Gender = Person_Gender) AND
            IIF(ISNULL(Person_Country),TRUE,Country = Person_Country)