Exporting Reports with subreports to excel (1 Viewer)

[GinaWhipp]

Confirm the path of the Template

 

[Snappy1263]

The path is correct

 

[Snappy1263]

ok so I thought maybe it would work today LOL so I exported but I pick one that didn't have data in the bom and didn't pay attention but when I opened another excel sheet I needed to see I closed it and there was the template open...weird right??? and of course all it had was the part number and no other data which would be right for the one I exported. Please tell me I am not crazy LOL

 

[GinaWhipp]

Oh, well you can't have an Excel spreadsheet opened with the same as you are trying to open. It will fail every time. Has that been the case?

 

[Snappy1263]

Sorry no I didnt have it open cant really explain how it happened but anyway. I tried to figure out why its not working since all you did was take out the footer n it was working before that but I didnt figure it out.

 

[GinaWhipp]

Well, I am stumped because the query has data the Template is there but the two do not meet. I have read and RE-read the code and see nothing wrong... I don't get it.

 

[Snappy1263]

I don't get it either. I put the old code back in and it worked except of course it places the footer there.

Have you come up with an idea on being able to do all records??

thanks,

 

[Snappy1263]

i went over this again and again...put the old code in runs fine then take out the foot information and excel doesnt open.... i am at a loss, i have to get this figured out.

 

[Snappy1263]

Hi there hope you are doing well. I have been working hard on this myself and I really think I have got most of it figured out except this footer. Well it turns out I need it but in a different way. What I need is the data to across columns not down and i dont need the ID. Can you help.

There is only one time I need this footer. The other ones i dont so i still need to figure out how to get rid of it

I have attached the sample. The columns headings are BH - BM

HERE IS THE CURRENT CODE

Option Compare Database
Private Sub Command466_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[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\Book5.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]
xlWSh.Range("A3").Value = Me.[SEWING PART NUMBER]
xlWSh.Range("A4").Value = Me.[BOW KIT PART NUMBER]
xlWSh.Range("D2").Value = Me.[FULL DESCRIPTION]
xlWSh.Range("S2").Value = Me.[ITEM CLASS]
xlWSh.Range("BX2").Value = Me.[ITEM TYPE]
xlWSh.Range("AZ2").Value = Me.[UPC CODE]
xlWSh.Range("CD2").Value = Me.[LOCATION 1]
xlWSh.Range("CE2").Value = Me.[LOCATION 2]
xlWSh.Range("CH2").Value = Me.[MRP#]
xlWSh.Range("CW2").Value = Me.[NOTES]

rst.Close
Set rst = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.SaveAs "S:\Allfiles\GLBT\BOM EXPORT\PART TABLE\SEARAYPART_" & 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\PART TABLE\SEARAYPART_" & 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

THANK YOU SO MUCH

 

[Snappy1263]

hi there

Have you had a chance to look at this...I know you are probably busy. I think I have it just about set I HOPE except for this issue.

 

[GinaWhipp]

Hmm, did not get a notification eMail that there was anything to look at

I will review tonight...

 

[Snappy1263]

Awww thats ok.... thank you for reviewing it...

 

[Snappy1263]

Hey,

Sorry to bother you but did you have a chance to look at this

thank you very much.

 

[GinaWhipp]

Nope.. so guess what I am doing RIGHT NOW!

 

[GinaWhipp]

Okay, so *qryWestportExport* would need to be a crosstab query in order to export like that. Is that query a crosstab?

 

[Snappy1263]

I had to run it without it deleting to see but its a select query...

 

[GinaWhipp]

Then it won't work without a lot of additional code and I do mean A LOT.

 

[Snappy1263]

damn...the template has to be like this for the upload to work in our new system.....i was hoping not to do this manually when the excel sheet opens. that would be some work...can you think of any other way.....your my miracle worker

 

[GinaWhipp]

Unless you make that a crosstab query, no I can't. The data exports as it shows in the query which is why the only *shortcut* I can think of is a crosstab.

 

[Snappy1263]

its the footer query that has this information...which comes from my query that holds the labor information.

in the code strSQLFooter = "SELECT[PART NUMBER], Expr6 " & _
"FROM [BOM PRICING EXTENDED DETAILS LABOR SEA RAY]"
Does this have to be a crosstab query????

this is where the info comes from...then puts it in qryWestportExportFooter for export to excel.