Exporting Reports with subreports to excel

You didn't post the code you are using now or the field names...
 
Sorry about that I just had to get it together. I have the info, I will send it shortly.

thanks,
 
Here is the screen shot of the form. i will work on the template today and the path for that. Here is the SQL statements. Let me know what you think.
thanks,

MAIN REPORT
SELECT MODELS.[MODEL PART NUMBER], [CUSTOMER BOM'S].[CANVAS PART NUMBERS], [CUSTOMER BOM'S].[CDI DESCRIPTION], [CANVAS PART NUMBERS].COLORS, [CANVAS PART NUMBERS].[ITEM CLASS], [CANVAS PART NUMBERS].[ITEM TYPE], MODELS.[ALPHA SORT], [CUSTOMER BOM'S].[UPC CODE], [CUSTOMER BOM'S].[MRP#], [CUSTOMER BOM'S].[WAREHOUSE A], [CUSTOMER BOM'S].[LOCATION 1], [CUSTOMER BOM'S].[LOCATION 2], [CUSTOMER BOM'S].[WAREHOUSE B], [CUSTOMER BOM'S].[LOCATION 1B], [CUSTOMER BOM'S].[LOCATION 2B], [CUSTOMER BOM'S].STANDARD, [CUSTOMER BOM'S].[LEVEL 1 DISCOUNT], [CUSTOMER BOM'S].[LEVEL 2 DISCOUNT], [CUSTOMER BOM'S].[LEVEL 3 DISCOUNT], [CUSTOMER BOM'S].[LEVEL 4 DISCOUNT], [CUSTOMER BOM'S].[LEVEL 5 DISCOUNT], [CUSTOMER BOM'S].[LEVEL 6 DISCOUNT], [CUSTOMER BOM'S].ID
FROM MODELS INNER JOIN ([CANVAS PART NUMBERS] INNER JOIN [CUSTOMER BOM'S] ON [CANVAS PART NUMBERS].[CANVAS PART NUMBERS] = [CUSTOMER BOM'S].[CANVAS PART NUMBERS]) ON MODELS.MODELS = [CUSTOMER BOM'S].MODELS
ORDER BY [CUSTOMER BOM'S].[CANVAS PART NUMBERS];

SUBREPORT
SELECT [SR BOM PRICING DETAILS BOW].[PART NUMBER], [SR BOM PRICING DETAILS BOW].QUANITY, [SR BOM PRICING DETAILS BOW].ID
FROM [PARTS LIST] INNER JOIN [SR BOM PRICING DETAILS BOW] ON [PARTS LIST].[PART NUMBER] = [SR BOM PRICING DETAILS BOW].[PART NUMBER];
SUBREPORT
SELECT [SR BOM PRICING DETAILS LABOR].[PART NUMBER], [SR BOM PRICING DETAILS LABOR].QUANITY, [SR BOM PRICING DETAILS LABOR].ID
FROM [PARTS LIST] INNER JOIN [SR BOM PRICING DETAILS LABOR] ON [PARTS LIST].[PART NUMBER] = [SR BOM PRICING DETAILS LABOR].[PART NUMBER];
SUBREPORT
SELECT [SR BOM PRICING DETAILS NON BOW].[PART NUMBER], [SR BOM PRICING DETAILS NON BOW].QUANITY, [SR BOM PRICING DETAILS NON BOW].ID
FROM [PARTS LIST] INNER JOIN [SR BOM PRICING DETAILS NON BOW] ON [PARTS LIST].[PART NUMBER] = [SR BOM PRICING DETAILS NON BOW].[PART NUMBER];
 

Attachments

  • FORM.jpg
    FORM.jpg
    92.2 KB · Views: 167
Here is the template and here is the paths

Template
S:\Allfiles\GLBT\BOM EXPORT

Saved
S:\Allfiles\GLBT\BOM EXPORT\BOMS

Let me know if I am forgetting something, I went back to all our post to make sure I give you what you need.

thank you
 

Attachments

Okay, well can I have a copy of the code you are using on the other database so I don't have to scroll back thru and figure it out... Can't look at till later tonight but want to have all the pieces and parts. :D
 
Sure no problem... I went back so I could remember how I sent you everything. Here is the current codes. thx


Private Sub Command579_Click()
Dim dbs As DAO.Database
Dim qryDef As DAO.QueryDef
Dim qryDefFooter As DAO.QueryDef
Dim strSQL As String
Dim strSQLFooter
Dim strWhere As String
Dim lngLen As Long
Set dbs = CurrentDb

strSQL = "SELECT ID, [PART NUMBER], [PART DESCRIPTION], SUPPLIER, COO, [COST W FREIGHT], UOM, QUANITY, Expr1, [FABRIC WIDTH], [EXPORT UOM], [Expr4] " & _
"FROM quniExportToExcel"

strSQLFooter = "SELECT ID, [PART NUMBER], QUANITY, Expr4 " & _
"FROM [BOM PRICING EXTENDED DETAILS LABOR V]"

'Number
If Not IsNull(Me.ID) Then
strWhere = strWhere & "([ID] = " & Me.ID & ") AND "
End If

lngLen = Len(strWhere) - 5

If lngLen <= 0 Then
strSQL = strSQL
Set qryDef = dbs.CreateQueryDef("qryWestportExport", strSQL)
'DoCmd.OpenQuery qryDef.Name
qryDef.Close
Set qryDef = Nothing
Call SendToExcel("qryWestportExport", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExport"
DoEvents
strSQLFooter = strSQLFooter
Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
'DoCmd.OpenQuery qryDef.Name
qryDefFooter.Close
Set qryDefFooter = Nothing
Call SendToExcelFooter("qryWestportExportFooter", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExportFooter"
Else
strWhere = Left$(strWhere, lngLen)
strSQL = strSQL & " WHERE " & strWhere
Set qryDef = dbs.CreateQueryDef("qryWestportExport", strSQL)
'DoCmd.OpenQuery qryDef.Name
qryDef.Close
Set qryDef = Nothing
Call SendToExcel("qryWestportExport", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExport"
DoEvents
strSQLFooter = strSQLFooter & " WHERE " & strWhere
Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
'DoCmd.OpenQuery qryDef.Name
qryDefFooter.Close
Set qryDefFooter = Nothing
Call SendToExcelFooter("qryWestportExportFooter", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExportFooter"
End If

dbs.Close
Set dbs = Nothing
End Sub
Function SendToExcel(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim lngMaxRow As Long
Dim lngMaxCol As Long
Dim strPath As String

On Error GoTo Err_Handler
'Location of Template
strPath = "S:\ALLFILES\SNAPPY\2016\WESTLAND EXPORT\Book2.xls"

Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")


Set xlWBk = ApXL.Workbooks.Open(strPath)
'ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets(strSheetName)
xlWSh.Range("I1").Value = Me.ID
xlWSh.Range("I2").Value = Me.[FULL PART NUMBER]
xlWSh.Range("I3").Value = Me.[MODELS.DESCRIPTION]

rst.MoveFirst
xlWSh.Range("A8").CopyFromRecordset rst

rst.Close
Set rst = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.SaveAs "S:\ALLFILES\SNAPPY\2016\EXACT FIT\WESTLAND EXPORT\Westland_" & Format(Date, "mm.dd.yyyy") & ".xlsx", 51
ApXL.DisplayAlerts = True
ApXL.Quit

Exit Function
Err_Handler:
DoCmd.SetWarnings True
MsgBox Err.DESCRIPTION, vbExclamation, Err.Number
Exit Function

End Function
Function SendToExcelFooter(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim lngMaxRow As Long
Dim lngMaxCol As Long
Dim strPath As String

On Error GoTo Err_Handler
'Location of Workbook
strPath = "S:\ALLFILES\SNAPPY\2016\EXACT FIT\WESTLAND EXPORT\Westland_" & Format(Date, "mm.dd.yyyy") & ".xlsx"

Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
Set xlWSh = xlWBk.Worksheets(strSheetName)

ApXL.Visible = True
rst.MoveFirst
xlWSh.Range("A46").CopyFromRecordset rst
' selects the first cell to unselect all cells
xlWSh.Range("A8").SELECT

xlWSh.Activate
xlWSh.Cells.Rows(7).AutoFilter
xlWSh.Cells.Rows(7).EntireColumn.AutoFit

rst.Close
Set rst = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.Save
ApXL.DisplayAlerts = True
'ApXL.Quit

Exit Function
Err_Handler:
DoCmd.SetWarnings True
MsgBox Err.DESCRIPTION, vbExclamation, Err.Number
Exit Function

End Function
 
Sorry, just finished up and too tired to do this tonight (long day), will look at tomorrow.
 
Okay, what are you trying to do, create another query from a query? Messy... In any event what happens when you try?
 
I want to do exactly what we did before but there are more fields from the main report and the subreports are basically the same but I only need a couple fields for that.
 
Okay but you didn't answer what happens when you use the above code. Does the query get created? Does the Spreadsheet even open?
 
So sorry its been a bad few weeks I am not all with it right now. I didnt try the code because the name of the fields are different. That is what i was having trouble with. I wanted to try to do it myself and change the field names and run it. I can work on that and see if it blows up LOL
 
That's what I would as I don't see any *obvious* errors.

Sending happy *feel better* thoughts your way! :D
 
I just found out that all my field names need to be changed we have a new system this is why i have to get this rolling. We need to upload all our BOMs to the new system so I need to export like we did before so i can upload from excel to the new system but there is different steps to do it. Some info goes in one step then the bom part goes in another step. So this is gonna take me some time. i will get back with you when i have this figured out. I should know today what fields I need for each one.

thanks,
 
Hi its me..

I have done pretty good so far but need a little help. I think I missed some stuff but the query has the right info

thanks

attached is my template 1... this is the easy one. And here is the code. it stops at this.

Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)


CODE:
rivate Sub Command579_Click()
Dim dbs As DAO.Database
Dim qryDef As DAO.QueryDef
Dim qryDefFooter As DAO.QueryDef
Dim strSQL As String
Dim strSQLFooter
Dim strWhere As String
Dim lngLen As Long
Set dbs = CurrentDb

strSQL = "SELECT ID, [PART NUMBER], QUANITY " & _
"FROM quniExportToExcel"



'Number
If Not IsNull(Me.ID) Then
strWhere = strWhere & "([ID] = " & Me.ID & ") AND "
End If

lngLen = Len(strWhere) - 5

If lngLen <= 0 Then
strSQL = strSQL
Set qryDef = dbs.CreateQueryDef("qryWestportExport", strSQL)
'DoCmd.OpenQuery qryDef.Name
qryDef.Close
Set qryDef = Nothing
Call SendToExcel("qryWestportExport", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExport"
DoEvents
strSQLFooter = strSQLFooter
Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
'DoCmd.OpenQuery qryDef.Name
qryDefFooter.Close
Set qryDefFooter = Nothing
Call SendToExcelFooter("qryWestportExportFooter", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExportFooter"
Else
strWhere = Left$(strWhere, lngLen)
strSQL = strSQL & " WHERE " & strWhere
Set qryDef = dbs.CreateQueryDef("qryWestportExport", strSQL)
'DoCmd.OpenQuery qryDef.Name
qryDef.Close
Set qryDef = Nothing
Call SendToExcel("qryWestportExport", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExport"
DoEvents
strSQLFooter = strSQLFooter & " WHERE " & strWhere
Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
'DoCmd.OpenQuery qryDef.Name
qryDefFooter.Close
Set qryDefFooter = Nothing
Call SendToExcelFooter("qryWestportExportFooter", "Sheet1")
DoCmd.DeleteObject acQuery, "qryWestportExportFooter"
End If

dbs.Close
Set dbs = Nothing
End Sub
Function SendToExcel(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim lngMaxRow As Long
Dim lngMaxCol As Long
Dim strPath As String

On Error GoTo Err_Handler
'Location of Template
strPath = "S:\ALLFILES\GLBT\BOM EXPORT\Book2.xls"

Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")


Set xlWBk = ApXL.Workbooks.Open(strPath)
'ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets(strSheetName)
xlWSh.Range("A2").Value = Me.[FULL PART NUMBER]

rst.MoveFirst
xlWSh.Range("B2").CopyFromRecordset rst

rst.Close
Set rst = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.SaveAs "S:\ALLFILES\GLBT\BOM EXPORT\BOMS\SEARAY _" & Format(Date, "mm.dd.yyyy") & ".xlsx", 51
ApXL.DisplayAlerts = True
ApXL.Quit

Exit Function
Err_Handler:
DoCmd.SetWarnings True
MsgBox Err.DESCRIPTION, vbExclamation, Err.Number
Exit Function

End Function
Function SendToExcelFooter(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim lngMaxRow As Long
Dim lngMaxCol As Long
Dim strPath As String

On Error GoTo Err_Handler
'Location of Workbook
strPath = "S:\ALLFILES\GLBT\BOM EXPORT\BOMS\SEARAY _" & Format(Date, "mm.dd.yyyy") & ".xlsx"

Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
Set xlWSh = xlWBk.Worksheets(strSheetName)

ApXL.Visible = True
rst.MoveFirst
xlWSh.Range("A46").CopyFromRecordset rst
' selects the first cell to unselect all cells
xlWSh.Range("A2").SELECT

xlWSh.Activate
xlWSh.Cells.Rows(7).AutoFilter
xlWSh.Cells.Rows(7).EntireColumn.AutoFit

rst.Close
Set rst = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.Save
ApXL.DisplayAlerts = True
'ApXL.Quit

Exit Function
Err_Handler:
DoCmd.SetWarnings True
MsgBox Err.DESCRIPTION, vbExclamation, Err.Number
Exit Function

End Function
 

Attachments

Right after that line there is a line to open the query, uncomment that line and comment the DeleteObject line so it will open and you can see the query.
 
This section below change to....

Code: 
Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
DoCmd.OpenQuery qryDef.Name
'qryDefFooter.Close
'Set qryDefFooter = Nothing
'Call SendToExcelFooter("qryWestportExportFooter", "Sheet1")
'DoCmd.DeleteObject acQuery, "qryWestportExportFooter"
 
error message

invalid SQL statement: expected 'DELETE', 'INSERT' , 'PROCEDURE', 'SELECT' , OR 'UPDATE'.

Then it stops here again

Set qryDefFooter = dbs.CreateQueryDef("qryWestportExportFooter", strSQLFooter)
 
You must log in or register to reply here.

Similar threads

F
Help request for creating Reports with pictures
Replies
3
Views
195
Mark_
M
S
Is there a way to have print/save options for filtered form without utilizing right click?
Replies
10
Views
488
Gasman
Gasman
Safaa
How to display a specific number of records in a subreport linked to the original report with the patient code
2
Replies
20
Views
754
Pat Hartman
P
F
Solved Mask with sub-mask filtered by 2 combined drop-down boxes and a checkbox, opening two different reports depending on the checkbox
Replies
6
Views
332
Faoineag
F
P
Solved current record PDF issues
2
Replies
23
Views
456
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom