Exporting Reports with subreports to excel (1 Viewer)

[GinaWhipp]

Please post the SQL of the query in question...

 

[Snappy1263]

Hey,

I figured out what was going on. I did get it to work but I can't figure out how to change a few things on where it puts the data on the excel sheet. I have attached the filled in excel sheet. I have highlighted in yellow

1. I dont need the ID number to export on the form.
2. I dont need the foot to export on the form. When I take that out is when I get the previous error.

thanks,

Here is the code.

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], QUANITY " & _
"FROM quniExportToExcel"

strSQLFooter = "SELECT ID, [PART NUMBER], QUANITY " & _
"FROM [BOM PRICING EXTENDED DETAILS LABOR SEA RAY EXPORT]"

'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("B2").Value = Me.ID
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("B2").SELECT

xlWSh.Activate
xlWSh.Cells.Rows(1).AutoFilter
xlWSh.Cells.Rows(1).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

 

[Snappy1263]

I got it to work and not export the ID number but I am not sure how to get it not to export the footer. I take it out on the first part of the code but there is a bunch written about the footer so I am not sure how to fix that.

thanks,

 

[Snappy1263]

Sorry I am asking you alot of questions. Right now when I export it only does one BOM at a time which is the record I have open on the form. So in order to do each BOM I click to the next form and export that one and so on. And of course the ID is the like between data on the form and subform. Is there a way to do all BOMS at once and export them to excel. But also have the choice to do just the one I am working on. I have to upload 100s of BOMs into our new system to start up. Then I will be uploading some at a time as I create them. Just let me know what you think.

Thanks,

 

[Snappy1263]

I know you are very busy but usually you reply either way. Just want to make sure everything is ok.

 

[Snappy1263]

Hope you are doing well, haven't heard from you.

How do I export to excel but want rows instead of columns. I tried googling it and haven't yet found what I need. Not sure if this is possible.

I have attached the excel sheet.

THANK YOU

 

[Snappy1263]

I finally did it myself I think LOL. The only thing that I need help with is.

Getting rid of the Excel Footer

Having the option to do more that one at a time. Right now it is set up to be the current record on the form.

Thanks,

 

[GinaWhipp]

So sorry, my day job just kept getting in the way... so glad you figured it out!

 

[Snappy1263]

Thank you for getting back to me. Was getting worried. I do have some issues to go over with you. I will send you my codes and my problems. But I did figure out some things on my own LOL.

thanks

 

[GinaWhipp]

I'll be around... things slowing down to their normal pace, at the moment...

(Nice to know someone missed me )

 

[Snappy1263]

Ok I have 4 different Codes and templates for each. Lets do one at a time.
This one works fine except
1. I dont need the footer information at all. Not sure how to get rid of that. I have hi-lighted it on the spreadsheet.
2. Right now it is set up to do the record that the form is on when I push the export button I made. Is there a way to do all records at one time. The reason being is that we have a new system and I to upload all these records. It will take so long to do them one at a time. But I still want to be able to do one at a time for new items once we have the new system up and running. I have attached my template with data so you can see how it looks.
Thanks so much.


Private Sub Command579_Click()

Dim outReportData As String
Dim xlFileName As String


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[PART NUMBER], QUANITY " & _
"FROM quniExportToExcel"

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

'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("B2").SELECT

xlWSh.Activate
xlWSh.Cells.Rows(1).AutoFilter
xlWSh.Cells.Rows(1).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

 

[Snappy1263]

here is the spreadsheet

 

[GinaWhipp]

To eliminate the Footer part the below should work...

Private Sub Command579_Click()
Dim outReportData As String
Dim xlFileName As String

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[PART NUMBER], QUANITY " & _
"FROM quniExportToExcel"
strSQLFooter = "SELECT ID, [PART NUMBER], QUANITY " & _
"FROM [BOM PRICING EXTENDED DETAILS LABOR SEA RAY]"
'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
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"
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

To drop all the records are you saying you want them all in their own workbook?

 

[Snappy1263]

I pasted the new code but it did not export to excel or open the it. And there was no error message.

To answer you question, I dont need them to be in separate workbooks when all records export.

thanks,

 

[GinaWhipp]

Hmm, odd. I cleaned it up a little, try this one...

Private Sub Command579_Click()
    Dim outReportData As String
    Dim xlFileName As String
    Dim dbs As DAO.Database
    Dim qryDef As DAO.QueryDef
    Dim strSQL As String
    Dim strWhere As String
    Dim lngLen As Long
    Set dbs = CurrentDb
    
    strSQL = "SELECT[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"
    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"
    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

Still trying to think how to handle sending out all, the only thing I can think of is a loop. Problem is it will overwrite because the will all go to Sheet1 and always start at the beginning.

 

[Snappy1263]

OK put the new code in and still nothing and no errors weird.

OK I knew that might me a problem doing all data but there are so many I hate to have to do them one at a time yikes. Thank you for trying to figure that out.

 

[GinaWhipp]

Hmm, uncomment out the line that prevents the query from opening. Let's see if there is any data in the query...

 

[Snappy1263]

Ok i did that the query opens and the data is in there....

 

[GinaWhipp]

Okay, so the next thing is to check the location of the Template and see it goes to it...

 

[Snappy1263]

The data does not go to the template