J
Junior728
Hi,
I am trying to include the field name of the table to return to a excel
sheet, but not a clue on how to call out the field names for all the columns
in the table using recordset. The results i got so far returns only the data
but not the field name or title in first row. how can i include that in the
recordset coding?
Below is my code for reference. can anyone advise? thanks in advance.
Option Compare Database
Public Function CopyRecordset2XL()
Dim objXLApp As Object
Dim objXLWb As Object
Dim objXLWs As Object
Dim strWorkBook As String
Dim strWorkSheet As String
Dim lngSheets As Long 'sheet number
Dim lngCount As Long 'counter
Dim MyDB As DAO.Database
Set MyDB = CurrentDb
Dim RecordMRP As DAO.Recordset
Dim strCrit As String
Dim strSQL As String
strCrit = [Forms]![QuerybyYear]![CustPN]
strSQL = "SELECT [2006 Full].Account,[2006 Full].[Customer PN], [2006
Full].[Mfg PN], "
strSQL = strSQL & "[2006 Full].[FC Load Date],[2006 Full].[LT Qty],
[2006 Full].[Cust OH],"
strSQL = strSQL & "[2006 Full].[Req Resv], [2006 Full].[MRP Resv], [2006
Full].[MRP BO], "
strSQL = strSQL & "[2006 Full].ATS, [2006 Full].[YTD Sales], [2006
Full].[Whse ATS], [2006 Full].[Avg Cost]"
strSQL = strSQL & "FROM [2006 Full] "
strSQL = strSQL & "WHERE [2006 Full].[Customer PN]='" & strCrit & "'"
'you have extra left bracket plus string parameter should be in quotes
Set RecordMRP = MyDB.OpenRecordset(strSQL)
Set objXLApp = CreateObject("Excel.Application")
'name and full path to use to save the xls file
'only create workbooks with 1 sheet
lngCount = objXLApp.SheetsInNewWorkbook 'save user's setting
strWorkBook = "\\txfil001\MKoh$\My WorkStation\Copy of Copy of MRPbyPN.xls"
objXLApp.SheetsInNewWorkbook = 1 'set for only 1 sheet
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook)
objXLApp.SheetsInNewWorkbook = lngCount 'restore user's setting
strWorkSheet = "Sheet1"
Set objXLWs = objXLWb.Worksheets(strWorkSheet)
objXLWs.Range("A1").CopyFromRecordset RecordMRP 'I want to copy start from
Header!
objXLWs.Columns.AutoFit
objXLWb.Save
objXLWb.Close
Set objXLWs = Nothing
Set objXLApp = Nothing
RecordMRP.Close
Set RecordMRP = Nothing
Set MyDB = Nothing
MsgBox ("Finally, i get it to work!!!")
End Function
I am trying to include the field name of the table to return to a excel
sheet, but not a clue on how to call out the field names for all the columns
in the table using recordset. The results i got so far returns only the data
but not the field name or title in first row. how can i include that in the
recordset coding?
Below is my code for reference. can anyone advise? thanks in advance.
Option Compare Database
Public Function CopyRecordset2XL()
Dim objXLApp As Object
Dim objXLWb As Object
Dim objXLWs As Object
Dim strWorkBook As String
Dim strWorkSheet As String
Dim lngSheets As Long 'sheet number
Dim lngCount As Long 'counter
Dim MyDB As DAO.Database
Set MyDB = CurrentDb
Dim RecordMRP As DAO.Recordset
Dim strCrit As String
Dim strSQL As String
strCrit = [Forms]![QuerybyYear]![CustPN]
strSQL = "SELECT [2006 Full].Account,[2006 Full].[Customer PN], [2006
Full].[Mfg PN], "
strSQL = strSQL & "[2006 Full].[FC Load Date],[2006 Full].[LT Qty],
[2006 Full].[Cust OH],"
strSQL = strSQL & "[2006 Full].[Req Resv], [2006 Full].[MRP Resv], [2006
Full].[MRP BO], "
strSQL = strSQL & "[2006 Full].ATS, [2006 Full].[YTD Sales], [2006
Full].[Whse ATS], [2006 Full].[Avg Cost]"
strSQL = strSQL & "FROM [2006 Full] "
strSQL = strSQL & "WHERE [2006 Full].[Customer PN]='" & strCrit & "'"
'you have extra left bracket plus string parameter should be in quotes
Set RecordMRP = MyDB.OpenRecordset(strSQL)
Set objXLApp = CreateObject("Excel.Application")
'name and full path to use to save the xls file
'only create workbooks with 1 sheet
lngCount = objXLApp.SheetsInNewWorkbook 'save user's setting
strWorkBook = "\\txfil001\MKoh$\My WorkStation\Copy of Copy of MRPbyPN.xls"
objXLApp.SheetsInNewWorkbook = 1 'set for only 1 sheet
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook)
objXLApp.SheetsInNewWorkbook = lngCount 'restore user's setting
strWorkSheet = "Sheet1"
Set objXLWs = objXLWb.Worksheets(strWorkSheet)
objXLWs.Range("A1").CopyFromRecordset RecordMRP 'I want to copy start from
Header!
objXLWs.Columns.AutoFit
objXLWb.Save
objXLWb.Close
Set objXLWs = Nothing
Set objXLApp = Nothing
RecordMRP.Close
Set RecordMRP = Nothing
Set MyDB = Nothing
MsgBox ("Finally, i get it to work!!!")
End Function