Export to existing excel template

[SuperTime]

I am a beginner in this area, so let me know if I forgot to list some info.

Following is the code I have so far and this runs without any errors but it does not allow me to save the output of the stored procedure to an existing excel pre formatted template. How do I modify the code to do that?

Imports System.Runtime.InteropServices.Marshal
Public Class Form1
Sub SaveAsExcel(ByVal rs As ADODB.Recordset, ByVal filename _
As String, Optional ByVal bHeaders As Boolean = True)

Dim xlApp As New Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim xlBooks As Microsoft.Office.Interop.Excel.Workbooks
Dim xlSheets As Microsoft.Office.Interop.Excel.Sheets
Dim xlCells As Microsoft.Office.Interop.Excel.Range

Dim sTemplate As String

'Field object
Dim fd As ADODB.Field

'Cell count, the cells we can use
Dim CellCnt As Integer

' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
' xlApp = New Microsoft.Office.Interop.Excel.Application
xlBook = xlApp.Workbooks.Add
xlSheet = xlBook.Worksheets.Add
xlBooks = xlApp.Workbooks

sTemplate = "c:\maidpro\TEST.xls"

xlBooks.Open(sTemplate) 'Load existing template with chart and formatting
xlBook = xlBooks.Item(1)
xlSheets = xlBook.Worksheets
xlSheet = CType(xlSheets.Item(1), Microsoft.Office.Interop.Excel.Worksheet)
xlSheet.Name = "First Sheet"
xlCells = xlSheet.Cells

'Get the field names
If bHeaders Then
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case Else
xlCells(1, CellCnt).Value = fd.Name
xlCells(1, CellCnt).Interior.ColorIndex = 33
xlCells(1, CellCnt).Font.Bold = True
CellCnt = CellCnt + 1
End Select
Next
End If


'Rewind the rescordset
rs.MoveFirst()
Dim i As Integer = 2
Do While Not rs.EOF()
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
'Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlCells(i, CellCnt).Value = _
rs.Fields(fd.Name).Value
'xlSheet.Columns().AutoFit
CellCnt = CellCnt + 1
End Select
Next
rs.MoveNext()
i = i + 1
Loop

'Fit all columns
CellCnt = 1
For Each fd In rs.Fields

Select Case fd.Type
'Case dbBinary, dbGUID, dbLongBinary, _
' dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Columns(CellCnt).AutoFit()
CellCnt = CellCnt + 1
End Select
Next


xlSheet.SaveAs("c:\maidpro\newTEST.xls") 'Save in a temporary file
xlBook.Close()

'Quit Excel and thoroughly deallocate everything
xlApp.Quit()
ReleaseComObject(xlCells) : ReleaseComObject(xlSheet)
ReleaseComObject(xlSheets) : ReleaseComObject(xlBook)
ReleaseComObject(xlBooks) : ReleaseComObject(xlApp)
xlApp = Nothing : xlBooks = Nothing : xlBook = Nothing
xlSheets = Nothing : xlSheet = Nothing : xlCells = Nothing
System.GC.Collect()
' Response.Redirect(sFile) 'Send the user to the file
' Close Microsoft Excel with the Quit method.

MsgBox("Congratualtions! The data has been exported to excel")


End Sub


Private Sub btnExportToExcel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExportToExcel.Click
Dim objCon As ADODB.Connection
Dim objCom As ADODB.Command
Dim objPara As ADODB.Parameter
Dim objpara2 As ADODB.Parameter
Dim objPara3 As ADODB.Parameter
Dim objpara4 As ADODB.Parameter
Dim objRS As ADODB.Recordset

objCon = New ADODB.Connection
objCom = New ADODB.Command

'Creating the DB connection string
objCon.ConnectionString = "PROVIDER=SQLOLEDB;PASSWORD=purduecpt;PERSIST SECURITY INFO=TRUE;USER ID=insight;INITIAL CATALOG=maidproboston;DATA SOURCE=DEV21"
objCon.CursorLocation = ADODB.CursorLocationEnum.adUseClient

'Opening the connection
objCon.Open(objCon.ConnectionString)

'assigning the command object parameters
With objCom
.CommandText = "up_MaidPro_rptMarketingResults" 'Name of the stored procedure
.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc 'Type : stored procedure
.ActiveConnection = objCon
End With

'Create 2 output parameters
objPara = objCom.CreateParameter("@StartDate", ADODB.DataTypeEnum.adDate, ADODB.ParameterDirectionEnum.adParamInput, , "05-01-2007")
objpara2 = objCom.CreateParameter("@EndDate", ADODB.DataTypeEnum.adDate, ADODB.ParameterDirectionEnum.adParamInput, , "05-30-2007")
objPara3 = objCom.CreateParameter("@OrgStructLevel", ADODB.DataTypeEnum.adInteger, ADODB.ParameterDirectionEnum.adParamInput, , 1)
objpara4 = objCom.CreateParameter("@OrgStructID", ADODB.DataTypeEnum.adInteger, ADODB.ParameterDirectionEnum.adParamInput, , 1)

objPara.Value = Date1.Value
objpara2.Value = Date2.Value

objPara3.Value = 1
objpara4.Value = 1

'Append the output parameters to command object
objCom.Parameters.Append(objPara)
objCom.Parameters.Append(objpara2)
objCom.Parameters.Append(objPara3)
objCom.Parameters.Append(objpara4)

'Store the result in a recordset
objRS = objCom.Execute

SaveAsExcel(objRS, Text1.Text) 'text is not used as of now

'Close the recordset
objRS.Close()
'close connection
objCon.Close()

'cleaning up
objCom = Nothing
objCon = Nothing
objPara = Nothing
objpara2 = Nothing
objRS = Nothing
End Sub

End Class

 

[ck1999]

Try replacing
xlSheet.SaveAs("c:\maidpro\newTEST.xls") 'Save in a temporary file

with
xlapp.SaveAs("c:\maidpro\newTEST.xls") 'Save in a temporary file

ck1999

 

[SuperTime]

Throws the following error:

MissingMemberException was unhandled
Public member 'SaveAs' on type 'ApplicationClass' not found.

 

[ck1999]

sorry try xlbook.SaveAs("c:\maidpro\newTEST.xls")
or xlbooks.SaveAs("c:\maidpro\newTEST.xls")

if this does not work please reply what it is not saving?

Also what program are you running this in?

ck1999

 

[SuperTime]

I used xlbook.SaveAs("c:\maidpro\newTEST.xls"), but still the same.

c:\maidpro\TEST.xls is my pre-formatted template in which I have added a chart and a calculation in the 11th column of the spreadsheet.

My stored procedure returns 10 columns, so my spread sheet has a calculated field.

I want the code that save the results of the stored procedure to save on the preformatted template of excel instead of a blank one.

 

[SuperTime]

I have created a Windows Application Project in VS2005

 

[ck1999]

Delete this section of code

xlBook = xlApp.Workbooks.Add
xlSheet = xlBook.Worksheets.Add


and change the next line to
set xlBooks = xlApp.Workbooks

ck1999

 

[ck1999]

This code works in acces 2007 try this

Dim xl As Excel.Application
Dim sh As Worksheet
Dim wbk As Workbook


Set xl = CreateObject("excel.Application")
' stemplate = "c:\maidpro\TEST.xls"
 stemplate = "c:\book1.xlsx"

xl.Workbooks.Open (stemplate) ' substitute your file here
 xl.Visible = True
 Set wbk = xl.ActiveWorkbook
 wbk.Sheets("First Sheet").Select
   Cells(1, 3) = "hello"
 
         'Get the field names
         Dim fd As ADODB.Field
        If bHeaders Then
            CellCnt = 1
            For Each fd In rs.Fields
                Select Case fd.Type
                    Case Else
                        Cells(1, CellCnt).Value = fd.NAME
                        Cells(1, CellCnt).Interior.ColorIndex = 33
                        Cells(1, CellCnt).Font.Bold = True
                        CellCnt = CellCnt + 1
                End Select
            Next
        End If


        'Rewind the rescordset
        rs.MoveFirst()
        Dim i As Integer = 2
        Do While Not rs.EOF()
            CellCnt = 1
            For Each fd In rs.Fields
                Select Case fd.Type
                    'Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
                    ' This type of data can't export to excel
                    Case Else
                        Cells(i, CellCnt).Value = _
                            rs.Fields(fd.NAME).Value
                        'xlSheet.Columns().AutoFit
                        CellCnt = CellCnt + 1
                End Select
            Next
            rs.MoveNext()
            i = i + 1
        Loop
        
        'Fit all columns
            ActiveSheet.Range("A1", "K1 ").Columns.AutoFit ' 1st 11 columns"
        
        
 
 wbk.SaveAs ("c:\maidpro\newTEST.xls") 'Save in a temporary file
 kwb.Close
 xl.Quit
 Set xl = Nothing
 Set wbk = Nothing

Make sure under tools reference you have the microsoft excel x.x object library checked.

ck1999

 

[SuperTime]

I used this code that you gave me in access 2003 hoping it will work there too.

But I also need a function that will call the stored procedure so i used my above code that does that but it gives me an error at
objCom.Parameters.Append (objpara)
objCom.Parameters.Append (objpara2)
objCom.Parameters.Append (objpara3)
objCom.Parameters.Append (objpara4)

any ideas?

 

[ck1999]

Do you know how to make a query for the information you want to export using either the query design or sql? If so design the query and post the code

I believe you have extremely over complicated the code to create a query.


ck1999