Trying to merge Excel template with Access

[fldbryan]

I am writing an excel spreadsheet in Access and wish to use a template for formatting purposes. However all that is produced is the generic spreadsheet. Here is the code. Any solutions gratefully accepted.

Sub MakeSS(TUser As String)
    ' Declare an object variable to hold the object
    ' reference. Dim as Object causes late binding.
    Dim ExcelSheet As Object
    
    Dim DB
    Dim RS
    
    Dim X
    
    X = 0
    
    Set DB = CurrentDb()
    Set RS = DB.OpenRecordset("Select * from qrySelectReqReportOpen where ALUserid='" & TUser & "'")
    Set ExcelSheet = CreateObject("Excel.Sheet")
    'open up template
    ExcelSheet.Application.Workbooks.Open "C:\AL.XLT"

    Do Until RS.EOF
        X = X + 1
        'populate excel row
        ExcelSheet.Sheets(1).Cells((X + 1), 1).Value = RS("Division")
        ExcelSheet.Sheets(1).Cells((X + 1), 2).Value = X
        ExcelSheet.Sheets(1).Cells((X + 1), 3).Value = RS("Req#")
        ExcelSheet.Sheets(1).Cells((X + 1), 4).Value = FullDate(RS("Opened"))
        ExcelSheet.Sheets(1).Cells((X + 1), 5).Value = FullDate(RS("TargetHireDate"))
        ExcelSheet.Sheets(1).Cells((X + 1), 6).Value = RS("Location")
        ExcelSheet.Sheets(1).Cells((X + 1), 7).Value = RS("Priority")
        ExcelSheet.Sheets(1).Cells((X + 1), 8).Value = RS("Department")
        ExcelSheet.Sheets(1).Cells((X + 1), 9).Value = RS("Position")
        ExcelSheet.Sheets(1).Cells((X + 1), 10).Value = RS("Status")
        ExcelSheet.Sheets(1).Cells((X + 1), 11).Value = FullDate(RS("NewHireDate"))
        ExcelSheet.Sheets(1).Cells((X + 1), 12).Value = RS("Hiring Manager")
        ExcelSheet.Sheets(1).Cells((X + 1), 13).Value = RS("RA")
        ExcelSheet.Sheets(1).Cells((X + 1), 14).Value = RS("Sourcing")
        ExcelSheet.Sheets(1).Cells((X + 1), 15).Value = RS("InternalTransferName")
        ExcelSheet.Sheets(1).Cells((X + 1), 16).Value = RS("ExternalCandidatename")
        ExcelSheet.Sheets(1).Cells((X + 1), 17).Value = RS("Recruitors")
        ExcelSheet.Sheets(1).Cells((X + 1), 18).Value = RS("Area Leader")
        ExcelSheet.Sheets(1).Cells((X + 1), 19).Value = RS("Variance")
        
        'Move to next record
        RS.MoveNext
    Loop
    
    ' Save the sheet to C:\ directory.
    ExcelSheet.Application.DisplayAlerts = False
    ExcelSheet.SaveAs "C:\OpenRequisitions.XLS"
    ExcelSheet.Application.DisplayAlerts = True
    On Error Resume Next
    ' Close Excel with the Quit method on the Application object.
    ExcelSheet.Application.Quit
    RS.Close
    DB.Close
    ' Release the object variable.
    Set ExcelSheet = Nothing
    Set RS = Nothing
    Set DB = Nothing
End Sub

 

[PHV]

you may try to amend you code like this:
...
Dim XL As Object, ExcelSheet As Object
...
Set XL = CreateObject("Excel.Application")
'open up template
Set ExcelSheet = XL.Workbooks.Add("C:\AL.XLT")
Do Until RS.EOF
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[fldbryan]

That was perfect.

Thank You