divehunter
asked on
Add header fields to an excel spreadsheet that is created using code
Hi, I have an Access module that parses data and creates individual spreadsheets. I'd like to add on the first 4 rows of the Excel spreadsheets some header information (i.e. company name and report name on row 1, the specific agents name on row 2, the month and date of the report on row 3 and "Company Confidential" on row 4. Then I'd like the individual parsed records (and column headings) to begin on row 5. I've included the module code below. Thanks in advance for your help.
Option Compare Database
Sub exp2XL2()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object
Set rsDir = CurrentDb.OpenRecordset("s elect distinct AgentName from tblAgentCommissionReportOu tput")
If rsDir.EOF Then Exit Sub
rsDir.MoveFirst
Do Until rsDir.EOF
Set xlObj = CreateObject("Excel.Applic ation")
xlObj.Workbooks.Add
ssql = "SELECT [tblAgentCommissionReportO utput].Age ntName, "
ssql = ssql & " [tblAgentCommissionReportO utput].Age ntTerritor y, "
ssql = ssql & " [tblAgentCommissionReportO utput].str AcctMgrLog in, "
ssql = ssql & " [tblAgentCommissionReportO utput].Cus tomerTerri tory, "
ssql = ssql & " [tblAgentCommissionReportO utput].dtC lientStart Date AS StartDate, "
ssql = ssql & " [tblAgentCommissionReportO utput].tDa te AS TransDate, "
ssql = ssql & " [tblAgentCommissionReportO utput].[De scription] , "
ssql = ssql & " [tblAgentCommissionReportO utput].Tra nsAmount, "
ssql = ssql & " [tblAgentCommissionReportO utput].Age ntComm, "
ssql = ssql & " [tblAgentCommissionReportO utput].Age ntPay, "
ssql = ssql & " [tblAgentCommissionReportO utput].Fra nchiseeNam e"
ssql = ssql & " FROM [tblAgentCommissionReportO utput]"
ssql = ssql & " Where AgentName='" & rsDir("AgentName") & "'"
Set rs = CurrentDb.OpenRecordset(ss ql, dbOpenDynaset)
Set Sheet = xlObj.activeworkbook.Sheet s("sheet1" )
'rename the sheet, you can use any of the recordset field
Sheet.Name = rsDir("AgentName")
'copy the headers
For iCol = 0 To rs.Fields.Count - 1
Sheet.cells(1, iCol + 1).Value = rs.Fields(iCol).Name
Next
Sheet.Range("A2").CopyFrom Recordset rs 'copy the data
xlObj.activeworkbook.SaveA s "C:\Documents and Settings\All Users\Desktop\" & rsDir("AgentName") & ".xls", FileFormat:=-4143
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Sub
Option Compare Database
Sub exp2XL2()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object
Set rsDir = CurrentDb.OpenRecordset("s
If rsDir.EOF Then Exit Sub
rsDir.MoveFirst
Do Until rsDir.EOF
Set xlObj = CreateObject("Excel.Applic
xlObj.Workbooks.Add
ssql = "SELECT [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " [tblAgentCommissionReportO
ssql = ssql & " FROM [tblAgentCommissionReportO
ssql = ssql & " Where AgentName='" & rsDir("AgentName") & "'"
Set rs = CurrentDb.OpenRecordset(ss
Set Sheet = xlObj.activeworkbook.Sheet
'rename the sheet, you can use any of the recordset field
Sheet.Name = rsDir("AgentName")
'copy the headers
For iCol = 0 To rs.Fields.Count - 1
Sheet.cells(1, iCol + 1).Value = rs.Fields(iCol).Name
Next
Sheet.Range("A2").CopyFrom
xlObj.activeworkbook.SaveA
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Sub
ASKER
This is the last item to finish this project so I thought I'd add some more points in the hope someone can help. Thanks in advance.
Hello divehunter,
1) It's difficult to read VBA code that is not indented properly. I think you may get more Expert involvement
if you'd indent.
2) Please post a mockup of what the final Excel output should look like. Fake the data if need be to protect
sensitive information.
Regards,
Patrick
1) It's difficult to read VBA code that is not indented properly. I think you may get more Expert involvement
if you'd indent.
2) Please post a mockup of what the final Excel output should look like. Fake the data if need be to protect
sensitive information.
Regards,
Patrick
better if you can attach a db with table tblAgentCommissionReportOu
and an example of the output excel file
ASKER
Hi, Thanks for the response. I've attached 1 workbook (3 worksheets). One is called sample and it shows what the current output spreadsheet looks like for each individual agent. The second spreadsheet (desired) is what I'd like to get it to look like. If it's a lot of work to bold the header fields and center them, don't worry about it. The 3rd is an excel (trunc) version of the tblAgentCommissionReportOu tput. Hope this helps. Sorry about not indenting. Still learning the ropes. I'll make sure I indent in the future. Thanks for the heads up and for all of your help.
projectsample.xls
projectsample.xls
where is the db with the table
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I have to Capricorn1 that it's obvious why you're #1. Everytime you help me I'm amazed by your knowledge. Thank you so much for all your help. This worked perfectly. I had to change the 'AllMountainTechnologies' back to AgentName but it couldn't work any better.
ASKER
PS - My boss asked me to let me know if you do any side contract work, we would be very interested in talking to you about some development work we need done. Thanks again.
look in my profile. send me a note.
ASKER
Thanks. I've forwarded your email address to my boss. He should be contacting you soon. His name is Carl Landis. Thanks again for all the help.
u r welcome!!!
ASKER