MS Access 导出子表格 VBA

Question

I've been through a bunch of posts on how to do this but I can't seem to find an answer that works.

I have the main form "SubCanButton" and the Subform "MasterQuery"

When you click submit it should export to an Excel spreadsheet with the info from the subquery "MasterQuery" but it keeps coming up blank and I can't figure it out.

My current code:

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

But I've also tried the following variations as well

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

I've also tried variations of the above as well but can't seem to get my data in the form. I'm not sure what I'm missing here. Any help would be greatly appreciated.

Answer 1

When you export data to excel then best practice is to export query so that you can pass multiple criteria to filter data to get desired results only. However if you want to export subform data or filtered subform data then you can use below sub.

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

I would like to suggest you to build a criteria then make a temporary query on the fly and export that query to excel and then delete the query. See below sub as an example. This is most efficient way to export filtered data to 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