Advertisement

05.25.2008 at 10:31PM PDT, ID: 23432065
[x]
Attachment Details

How can I generate the table field names as the first row in the Excel output file ?

Asked by zimmer9 in Microsoft ADP, Microsoft Excel Spreadsheet Software, Access Coding/Macros

I am developing an Access 2003 application using Access as the front end and SQL Server as the back end database.

In the attached code snippet, I first display a routine that executes a stored procedure to create a result set into an Access table.

The routine is titled UDLIntToExcel().

This routine calls another routine titled ExportToExcels which is also shown in the attached code snippet. This routine will take care of writing records to an Excel file from the result set stored in the Access table even when the number of records generated exceeds 65,535 records, the limit of Excel 2003.

My question is do you know how I can have the records written to Excel in such a way, that the first record written displays the fields from the Access table as a heading ?

Currently this routine titled ExportToExcels displays the detail records without a heading of the field titles. Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:

Private Sub UDLIntToExcel()
    Dim cn As ADODB.Recordset
    Dim ExportedFile As String
    Dim ImportedFile As String
    Dim strNextFile As String
    Dim rstQueryFS As ADODB.Recordset
    Dim objXL As Excel.Application
    Dim objWS As Excel.Worksheet
    Dim fld As ADODB.Field
    Dim intCol As Integer
    Dim intRow As Integer
    Dim strSQL As String
    Dim intBonds As Integer
    Dim com As ADODB.Command
    Dim P1 As New Parameter
    Dim str_sql As String
    Dim filename As String
    Dim strAccessPath2 As String
              
    str_sql = "If  Exists(SELECT * FROM dbo.SYSOBJECTS WHERE NAME = 'tblRemedInternal' AND TYPE = 'U') DROP TABLE tblRemedInternal"
    DoCmd.RunSQL (str_sql)
    
    Set cn = New ADODB.Recordset
    
    cn.ActiveConnection = CurrentProject.Connection
    cn.CursorType = adOpenStatic
    cn.CursorLocation = adUseServer
    cn.LockType = adLockReadOnly
               
    DoCmd.Hourglass True
    Set com = New ADODB.Command
    With com
       .CommandTimeout = 95
       .CommandType = adCmdStoredProc
       .CommandText = "dbo.procRemedInternal2"
       .ActiveConnection = CurrentProject.Connection
       Set rstQueryFS = .Execute
    End With
               
    ExportedFile = strAccessPath0 & strAccessPath7 & "INTERNAL" & "_" & intYearSP & "_" & Format(Now, "mmddhhnnss") & ".XLS"
    
    ExportToExcels ExportedFile
    
    Beep
    MsgBox "Internal has been exported to Excel", vbOKOnly, ""
      
    If isFileExist(ExportedFile) Then StartDocInternalXLS ExportedFile
    DoCmd.Hourglass False
End Sub
***************************************************************
Private Sub ExportToExcels(filename As String)
Dim str_sql As String
Dim cn As ADODB.Connection
Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim sht As Excel.Worksheet, rng As Excel.Range
Dim db As DAO.Database, rs As ADODB.Recordset
Dim recordtotal As Long
Dim SheetNum As Long
Dim dest As Range
Dim Counter As Long
Dim Source As Workbook
 
 
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
 
Set db = CurrentDb
 
recordtotal = DCount("ProdID", "tblRemedInternal")
Set xl = CreateObject("Excel.Application")
 
Set xlWB = xl.Workbooks.Add ' Add a new workbook
xlWB.SaveAs filename ' Save the new workbook as "filename"
Set xlWB = xl.Workbooks.Open(filename)  '<--Your Excel File Here
 
 
xl.Visible = True
SheetNum = 1
Do While recordtotal > 0
    rs.Open "Select top 60000 * from tblRemedInternal", cn, 2, 2
    If rs.EOF Then Exit Sub
    rs.MoveFirst
        Set sht = Nothing
        On Error Resume Next
        Set sht = xlWB.Worksheets("Sheet" & SheetNum)
        On Error GoTo 0
        
        If sht Is Nothing Then
        xlWB.Worksheets.Add After:=Worksheets(Worksheets.count)
            Set sht = ActiveSheet
            sht.Name = "Sheet" & SheetNum
        End If
        sht.Range("A1").CopyFromRecordset rs
        SheetNum = SheetNum + 1
        str_sql = "delete from tblRemedInternal where ProdID in(Select top 60000 ProdID from tblRemedInternal)"
        DoCmd.RunSQL (str_sql)
    rs.Close
    recordtotal = DCount("ProdID", "tblRemedInternal")
Loop
 
xlWB.Close (True)
xl.Quit
Set xl = Nothing
 
End Sub
[+][-]05.25.2008 at 11:35PM PDT, ID: 21644951

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Microsoft ADP, Microsoft Excel Spreadsheet Software, Access Coding/Macros
Sign Up Now!
Solution Provided By: webtubbs
Participating Experts: 1
Solution Grade: A
 
 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628