Search code examples
ms-accessvbams-access-2016

Export (4) Forms/Subforms query and table data to Excel

I have found multiple articles on how to output (1) Access form/subform to excel, but I cannot find anything that will explain to me how to output 4 subforms to the same workbook.

I would like to export the following subforms to one excel workbook:

[tmp_Formula]

[qry_BatchCoating subform]

[qry_ContinuousCoating subform]

[qry_ENCAP subform]

Ideally, I would like to export them to (1) sheet in static positions. Meaning I would want to output one subform starting at A1, the next starting at A26, the next at G26, and the last subform at N26. If this isn't possible, exporting them to a single workbook is still my goal.

Any help would be appreciated. Thanks! enter image description here

enter image description here

Solution

  • So I was unable to find any reference online that suited my needs for extracting 4 datasets and posting them to one worksheet in Excel. dbMitch pointed me in the right direction, however I couldn't get that code to work because of my database format being accdb and not mdb.

    So I wrote this using the vba reference from microsoft and a lot of trial and error. Anyways, this works and I hope future readers see it. The bit where it says, "For Each fld In rs..." That's where you play around with where you want the dataset to land on the spreadsheet. Hope this helps!

    Private Sub Command25_Click()

Dim rs1, rs2, rs3, rs4 As DAO.Recordset
Dim cnt As Integer

Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range

Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Add
Set wks = wbk.Worksheets(1)
Set rng = wks.Range("A2")

appExcel.Visible = False

cnt = 1

Set rs1 = CurrentDb.OpenRecordset("SELECT tmp_Formula.RawMaterial, tmp_Formula.MiscInfo, tmp_Formula.Potency, " _
  & "tmp_Formula.PUoM, tmp_Formula.Claim, tmp_Formula.CUoM, tmp_Formula.Overage, " _
  & "tmp_Formula.Input, tmp_Formula.InputWeight, tmp_Formula.DV, tmp_Formula.Cost, " _
  & "tmp_Formula.CostUoM, tmp_Formula.BulkCost, tmp_Formula.BCWeight, " _
  & "IIf([Quantity]>=15,Format([Quantity],'0.0'),Format([Quantity],'0.000')) AS Qty, tmp_Formula.UoM " _
  & "FROM tmp_Formula;")

    For Each fld In rs1.Fields
        wks.Cells(1, cnt).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs1, 4000, 26)

Set rng = wks.Range("T3")

Set rs2 = CurrentDb.OpenRecordset("SELECT tbl_BatchCoatingIngredients.RawMaterial, tbl_BatchCoatingIngredients.Solution, " _
  & "tbl_BatchCoatingIngredients.Color, tbl_BatchCoatingIngredients.Quantity, tbl_BatchCoatingIngredients.UoM " _
  & "FROM tbl_BatchCoatingIngredients " _
  & "WHERE ((tbl_BatchCoatingIngredients.BP)='" & [Forms]![frm_Formulation]![BP] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.Old)=No);")

  wks.Cells(1, 20).Value = "Batch Coating"

    For Each fld In rs2.Fields
        wks.Cells(2, cnt + 3).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs2, 4000, 26)

Set rng = wks.Range("T17")

Set rs3 = CurrentDb.OpenRecordset("SELECT tbl_ContinuousCoatingIngredients.RawMaterial, tbl_ContinuousCoatingIngredients.Solution, " _
  & "tbl_ContinuousCoatingIngredients.Color, tbl_ContinuousCoatingIngredients.Quantity, tbl_ContinuousCoatingIngredients.UoM " _
  & "FROM tbl_ContinuousCoatingIngredients " _
  & "WHERE (((tbl_ContinuousCoatingIngredients.BP)='" & [Forms]![frm_Formulation]![BP] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.Old)=No));")

  wks.Cells(15, 20).Value = "Continuous Coating"

    For Each fld In rs3.Fields
        wks.Cells(16, cnt - 2).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs3, 4000, 26)

Set rng = wks.Range("T31")

Set rs4 = CurrentDb.OpenRecordset("SELECT tbl_ENCAP.RawMaterial, tbl_ENCAP.Solution, tbl_ENCAP.Color, tbl_ENCAP.Quantity, tbl_ENCAP.UoM " _
  & "FROM tbl_ENCAP " _
  & "WHERE (((tbl_ENCAP.BP)='" & [Forms]![frm_Formulation]![BP] & "') AND ((tbl_ENCAP.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_ENCAP.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "')) AND ((tbl_ENCAP.Old)=No);")

  wks.Cells(29, 20).Value = "Encapsulation"

    For Each fld In rs3.Fields
        wks.Cells(30, cnt - 7).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs4, 4000, 26)

rs1.Close
Set rs1 = Nothing

rs2.Close
Set rs2 = Nothing

rs3.Close
Set rs3 = Nothing

rs4.Close
Set rs4 = Nothing

With wks.Range("A1:P1, T2:X2, T16:X16, T30:X30")
    .EntireColumn.AutoFit
    .Font.Bold = True
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 1
    .HorizontalAlignment = xlCenter
End With

With wks.Range("G:G, I:I, J:J, N:N")
    .NumberFormat = "0.00%"
End With

appExcel.Visible = True

    End Sub