MS Access 导出子表格 VBA

Question

我已经阅读了很多关于如何做到这一点的帖子，但我似乎找不到有效的答案。

我有主表单“SubCanButton”和子表单“MasterQuery”

当您单击提交时，它应该导出到 Excel 电子表格，其中包含来自子查询“MasterQuery”的信息，但它一直显示为空白，我无法弄清楚。

我当前的代码：

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, [Forms]![SubCanButton].Form.[MasterQuery].Name, "C:\Users\" & Owner & "\Desktop\ " & Format(Now(), "MM-DD-YY") & " Retail Change Request.xlsx", False

但我也尝试过以下变体

DoCmd.OutputTo acOutputQuery, "MasterQuery", acFormatXLS, "C:\Users\" & Owner & "\Desktop\ " & Format(Now(), "MM-DD-YY") & " Retail Change Request.xlsx", False

DoCmd.OutputTo acOutputForm, [Forms]![SubCanButton].Form.[MasterQuery].Name, acFormatXLS, "C:\Users\" & Owner & "\Desktop\ " & Format(Now(), "MM-DD-YY") & " Retail Change Request.xlsx", False

我也尝试过上述方法的变体，但似乎无法以表格形式获取我的数据。 我不确定我在这里缺少什么。 任何帮助将不胜感激。

Answer 1

当您将数据导出到 excel 时，最佳做法是导出查询，以便您可以传递多个条件来过滤数据以仅获得所需的结果。 但是，如果您想导出子表单数据或过滤的子表单数据，那么您可以使用下面的子表单。

Private Sub cmdExportSubFormToExcel_Click()
Dim rsClone As DAO.Recordset
Set rsClone = Me.subChallanStatus.Form.RecordsetClone 'subChallanStatus is subform control

If rsClone.EOF Then
MsgBox "No records found."
Set rsClone = Nothing
Exit Sub
End If

    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
        .Visible = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
        
        .ActiveSheet.Range("A2").CopyFromRecordset rsClone
        
        For i = 1 To rsClone.Fields.Count
            xlApp.ActiveSheet.Cells(1, i).Value = rsClone.Fields(i - 1).Name
        Next i
        'xlApp.Cells.EntireColumn.AutoFit 'Autofit for column width
    End With
End Sub

我建议您建立一个条件，然后即时进行临时查询并将该查询导出到 excel，然后删除该查询。 请参阅下面的 sub 作为示例。 这是将过滤后的数据导出到 excel 的最有效方式。

Private Sub cmdExportSubFormData_Click()
Dim strCriteria As String
Dim strSql As String
Dim qdf As QueryDef
    
    '============= Filter data between two date. =====================================================================
    If (Not IsNull(Me.txtStartDate)) Or (Not IsNull(Me.txtEndDate)) Then
         strCriteria = "[DoD]>= #" & Me.txtStartDate & "# " & "AND [DoD] <= #" & Me.txtEndDate & "# "
    Else
         strCriteria = ""
    End If


    '============== Condition-1 ======================================================================================
    If Not IsNull(Me.txtJobNo) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [JobNo] LIKE '*" & Me.txtJobNo & "*' "
          Else
             strCriteria = "[JobNo] LIKE '*" & Me.txtJobNo & "*' "
          End If
    Else
         strCriteria = strCriteria
    End If

    '============== Condition-2 ======================================================================================
    If Not IsNull(Me.cboFactory) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [Factory] LIKE '*" & Me.cboFactory & "*' "
          Else
             strCriteria = "[Factory] LIKE '*" & Me.cboFactory & "*' "
          End If
    Else
         strCriteria = strCriteria
    End If

    '============== Condition-3 ======================================================================================
    If Not IsNull(Me.cboBuyer) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [Buyer] LIKE '*" & Me.cboBuyer & "*' "
          Else
             strCriteria = "[Buyer] LIKE '*" & Me.cboBuyer & "*' "
          End If
    Else
         strCriteria = strCriteria
    End If

    '============== Condition-4 ======================================================================================
    If Not IsNull(Me.txtRef) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [Reference] LIKE '*" & Me.txtRef & "*' "
          Else
             strCriteria = "[Reference] LIKE '*" & Me.txtRef & "*' "
          End If
    Else
         strCriteria = strCriteria
    End If
    
    '============== Condition-4 ======================================================================================
    If Not IsNull(Me.cboSalesPerson) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [SalesPerson] LIKE '*" & Me.cboSalesPerson & "*' "
          Else
             strCriteria = "[SalesPerson] LIKE '*" & Me.cboSalesPerson & "*' "
          End If
    Else
         strCriteria = strCriteria
    End If
    
    '============== Condition-4 ======================================================================================
    If Not IsNull(Me.txtRcvDate) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [ReceivedDate] = #" & Me.txtRcvDate & "# "
          Else
             strCriteria = "[ReceivedDate] = #" & Me.txtRcvDate & "# "
          End If
    Else
         strCriteria = strCriteria
    End If
    
    '============== Condition-4 ======================================================================================
    If Not IsNull(Me.cboStatus) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [Status] = '" & Me.cboStatus & "' "
          Else
             strCriteria = "[Status] = '" & Me.cboStatus & "' "
          End If
    Else
         strCriteria = strCriteria
    End If
    
    '============== Condition-4 ======================================================================================
    If Not IsNull(Me.cboUnit) Then
          If Len(strCriteria) > 0 Then
             strCriteria = strCriteria & "AND [Unit] = '" & Me.cboUnit & "' "
          Else
             strCriteria = "[Unit] = '" & Me.cboUnit & "' "
          End If
    Else
         strCriteria = strCriteria
    End If



strSql = "SELECT * FROM tblMasterLocal WHERE " & strCriteria

On Error Resume Next
'Delete the query if it already exists
DoCmd.DeleteObject acQuery, "qryExportSubForm"

Set qdf = CurrentDb.CreateQueryDef("qryExportSubForm", strSql) 'as already in example
'DoCmd.OpenQuery qdf.Name 'Open query to see filtered data.

DoCmd.OutputTo acOutputQuery, "qryExportSubForm", acFormatXLSX, "Challan_Status.xlsx", True

'release memory
'qdf.Close 'i changed qdef to qdf here and below
Set qdf = Nothing
DoCmd.DeleteObject acQuery, "qryExportSubForm"

End Sub