Transfer Single Recod in Access into Specific cells in Excel

[jwlee4]

First off i will let you know the reason i am trying to do this. We are trying to keep our test reports better organized and have created a database that stores the data for each test. Fields include Model; Type; Date Tested; Tested By; Test Procedure; Name of Test; Test Results and the like. Each record is stored with that info and i need to be able to transfer it to our ISO9000 approved form that we keep in excel so we can print it off and get it signed by managers and put into record retention.
So with that being said I am trying to solve a problem with transferring the information from a single record on a form into an excel template that is already formatted the way that i need. So far i have been able to get the info from off the form that is being displayed, and using a query i have written the information in one line on a new table. I intend to be able to push a command button on the form and transfer the data into the formatted excel sheet so far i have this.
Code:

Private Sub Command40_Click()DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_Export"
DoCmd.SetWarnings True
Dim oExcel As New Excel.Application
Dim WB As New Excel.Workbook
Dim WS As Excel.Worksheet
Dim rng As Excel.Range
Dim objConn As New ADODB.Connection
Dim objRs As New ADODB.Recordset
Const sFileNameTemplate As String = "D:\DATA\ACCESS\ExcelTemplates\TestReportTemp.xls"
Dim sSQL As String
Set objConn = CurrentProject.Connection
sSQL = "Select * from tbl_Export" 'This has to be the name of the query/table your report is using to display data
With oExcel
    .Visible = True
               'Create new workbook from the template file
                Set WB = .Workbooks.Add(sFileNameTemplate)
                        With WB
                             Set WS = WB.Worksheets("Sheet1") 'Replace with the name of actual sheet
                             With WS
                                      objRs.Open sSQL, objConn, adOpenStatic, adLockReadOnly
                                      Set rng = .Range("A2") 'Starting point of the data range
                                      rng.CopyFromRecordset objRs
                                      objRs.Close
                             End With
                        End With
    .Quit
End With
 
Set objConn = Nothing
Set objRs = Nothing
End Sub

This getting the data from the record that i want and transferring it succesfully to excel but it just puts it in one line starting with the Range that i have specified. I need to split up each cell coming from access and direct them into there coresponding cell in excel. Any Help would be appreciated.

 

[Norie]

Do you have a sort of 'mapping' of which fields go in which cell?

 

[jwlee4]

Yes here is the Excel worksheet that i am want to export the data to. I have put the cell names into the box that i want to transfer the data to.
https://www.dropbox.com/s/0k3mkqkr0riho22/Testtemp.GIF

And here is what the data looks like when i transfer it to excel now. You can see that it sends all the relevent data from the record that i want but it just puts them into one row starting with the range that i specified in the code (cell A2)

https://www.dropbox.com/s/uubxzqras2qr82t/CurrentTest.GIF

I just need to send the data from each feild to the correspnding cell that it needs to go in. thanks for the quci reply

 

[SydneyGeek]

You have 2 options. One requires additional code, the other just uses links in Excel.
Second option first:
1. Transfer the record as you have been doing, but to a Data sheet (not the ISO layout)
2. Link the cells in the ISO sheet to the appropriate cells in the ISO layout
When you run the transfer, you should see a completed ISO report, ready to print

First option:
In Access, or in Excel, you can write code that takes your transferred recordset data and copies it cell by cell to the desired locations

Denis

 

[jwlee4]

Thanks denis for your help i was able to get the info into the ISO form using the first option. It worked out wonderfully. Here is the updated code if anyone out there comes across the same problem.

Private Sub Command40_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_Export"
DoCmd.SetWarnings True
Dim oExcel As New Excel.Application
Dim WB As New Excel.Workbook
Dim WS As Excel.Worksheet
Dim rng As Excel.Range
Dim objConn As New ADODB.Connection
Dim objRs As New ADODB.Recordset
Const sFileNameTemplate As String = "D:\DATA\ACCESS\ExcelTemplates\TestReportTemplate.xls"
Dim sSQL As String
Set objConn = CurrentProject.Connection
sSQL = "Select * from tbl_Export" 'This has to be the name of the query/table your report is using to display data
With oExcel
    .Visible = True
               'Create new workbook from the template file
                Set WB = .Workbooks.Add(sFileNameTemplate)
                        With WB
                             Set WS = WB.Worksheets("Sheet1") 'Replace with the name of actual sheet
                             With WS
                                      objRs.Open sSQL, objConn, adOpenStatic, adLockReadOnly
                                      'Set rng = .Range("A2") 'Starting point of the data range
                                      'Code below allows to insert each field into a separate designated cell
                                      WS.Cells(1, 2) = objRs.Fields("RunID")
                                      WS.Cells(3, 2) = objRs.Fields("Test Name")
                                      WS.Cells(2, 5) = objRs.Fields("Model")
                                      WS.Cells(2, 6) = objRs.Fields("Type")
                                      WS.Cells(2, 7) = objRs.Fields("Tested By")
                                      WS.Cells(2, 9) = objRs.Fields("Tested By 2")
                                      WS.Cells(4, 5) = objRs.Fields("Test Period")
                                      WS.Cells(4, 6) = objRs.Fields("Test Duration")
                                      WS.Cells(6, 1) = objRs.Fields("Test Procedure")
                                      WS.Cells(6, 6) = objRs.Fields("Test Criteria")
                                      WS.Cells(23, 2) = objRs.Fields("Objective")
                                      WS.Cells(23, 10) = objRs.Fields("Design Change Num")
                                      WS.Cells(24, 9) = objRs.Fields("ProtoMass")
                                      WS.Cells(48, 2) = objRs.Fields("Conclusions")
                                      WS.Cells(52, 1) = objRs.Fields("PassFail")
                                      'rng.CopyFromRecordset objRs
                                      objRs.Close
                             End With
                        End With
    '.Save
    '.Quit
End With
 
Set objConn = Nothing
Set objRs = Nothing
End Sub