Export multiple subforms to single spreadsheet

LFC

Registered User.
Local time
Today, 08:08
Joined
Jul 22, 2010
Messages
43
Hi,

I have a form with four subforms on it that are all filtered when the form opens. When a button is clicked I would like to have each subform exported to separate sheets in a new excel workbook. I have been looking all over trying to figure it out, but can't find anything.

Thanks
 
An extract of something I am doing is indicated below, you have to set the references in the VBA screen to use Excel and ADODB, use the ALt + F11 key on the keyboard then go to Tools and References.

Function myInvestigation()
'***************************************************************************************
'VBA Code created by Trevor G
'***************************************************************************************
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'***************************************************************************************
'First stage is to take the first query and place it
'On sheet1 and rename sheet1 to "Combined" which is to
'identify that this has come from the Combined table in COD
'***************************************************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM qryInvestination17032010"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set ws = CreateObject("Excel.Application")
With ws
.Workbooks.Add
.Visible = True
End With
ws.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:Q").EntireColumn.AutoFit
rst.Close
ws.Sheets("sheet1").Name = "Combined"
ws.ActiveSheet.PageSetup.LeftHeader = "&A & &D"
ws.Columns("E:H").NumberFormat = "0"
ws.Columns("E:H").EntireColumn.AutoFit
'***************************************************************************************
'Second stage is to take the second query and place it
'On sheet2 and rename sheet2 to "DBO" which is to
'identify that this has come from workflow but converting
'the MI Reference to 19 Characters which is done in the query
'I am also using a named range "DBO"
'***************************************************************************************
strSQL = "SELECT * FROM qryDBOGroup10022010New"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
ws.Sheets("Sheet2").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:h").EntireColumn.AutoFit
rst.Close
ws.Sheets("sheet2").Name = "DB0"
ws.ActiveSheet.PageSetup.LeftHeader = "&A & &D"
ws.Columns("B:B").NumberFormat = "0"
ws.Columns("B:B").EntireColumn.AutoFit
ws.Range("a2").Select
ws.Selection.CurrentRegion.Name = "dbo"
'***************************************************************************************
'Third stage is to take the second query and place it
'On sheet3 and rename sheet3 to "DBO System 18 Character" which is to
'identify that this has come from workflow but converting
'The MI Reference characters to 18 again which is done in the query
'I am also using a named range "DBO_System_18_Character"
'***************************************************************************************
strSQL = "SELECT * FROM qryDBOGroup24022010"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
ws.Sheets("Sheet3").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:h").EntireColumn.AutoFit
rst.Close
ws.Sheets("sheet3").Name = "DBO System 18 Character"
ws.ActiveSheet.PageSetup.LeftHeader = "&A & &D"
ws.Range("a2").Select
ws.Columns("B:B").NumberFormat = "0"
ws.Columns("B:B").EntireColumn.AutoFit
ws.Selection.CurrentRegion.Name = "DBO_system_18_Character"
'***************************************************************************************
'Forth stage is to take the third query and place it
'On sheet4 and rename sheet3 to "DBO LimitIris Phoenix" which is to
'identify that this has come from workflow looking for Limit Iris or Phoenix
'I am also using a named range "LimitIris_Phoenix"
'***************************************************************************************
strSQL = "SELECT * FROM qryDBOLimitIris_Phoenix_26022010"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Sheets.Add
ws.Sheets("sheet4").Select
ws.Range("a1") = "PolicyRef"
ws.Range("b1") = "MIRef"
ws.Range("c1") = "System"
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:h").EntireColumn.AutoFit
rst.Close
ws.Sheets("sheet4").Name = "DBO LimitIris Phoenix"
ws.ActiveSheet.PageSetup.LeftHeader = "&A & &D"
ws.Columns("B:B").NumberFormat = "0"
ws.Columns("B:B").EntireColumn.AutoFit
ws.Range("a2").Select
ws.Selection.CurrentRegion.Name = "LimitIris_Phoenix"

End Function

I hope this helps and you can adapt the relevant parts to your specific needs
 

Users who are viewing this thread

Back
Top Bottom