Export to Excel (Groan) (1 Viewer)

hudson426

Registered User.
Local time
Today, 20:58
Joined
Jun 19, 2009
Messages
28
Hi folks, need some help on a problem I am having:-

I have three tables I'm trying to export into Excel. These are:-

Master
Live
Archive

I have a template excel spreadsheet called:-

Draft Workbook.xls

Inside this template file are three worksheets called:-

Master
Live
Archive

The template file is stored in this location:-

T:\PH DMT\PS folder\PS Workbook\Export Folder

I want to export the three tables into the corresponding worksheets. The worksheets have header columns, so the data needs to imported into cell A6 in each of the worksheets.

The problem:-

If I try the transferspreadsheet option I get the "too many fields defined" error. I have read a million threads on this subject but I cant seem to adapt them to my needs. Or when I do get it to work I cant nest the statements properly.

I would like to assign the code to the On Click event of a command button

Please can somebody help me out?
 

ezfriend

Registered User.
Local time
Today, 12:58
Joined
Nov 24, 2006
Messages
242
This is what I use for export some records to an excel file. Hope this help.

Code:
'FORM - frmExportToExcel

Private Sub cmdExport_Click()

    Dim r As Long ' row number
    Dim rStart As Long
    Dim rEnd As Long
    Dim objXls As Excel.Workbook
    Dim sFileName As String

    sFileName = format"C:\" & Format(Now(), "YYYYMMDDHHMM") & "-SummaryReport.xls"
    xlsApp.Workbooks.Add
    xlsApp.ActiveWorkbook.SaveAs sFileName
    xlsApp.ActiveWorkbook.Close

    Set objXls = xlsApp.Workbooks.Open(sFileName)

    'make sure excel is not visible while processing the data
    xlsApp.Visible = False

    'PROCESS THE MASTER TABLE
    '-------------------------------------------------------------------------------------------------
    sSQL = ""
    sSQL = sSQL & "SELECT * FROM Master "

    Set rs = CurrentDb.OpenRecordset(sSQL)

    With objXls.Sheets(1)
	'since you already know what the columns are, just define them here. For example.
	r = 6
	
	Do While rs.EOF = False
	
	    .RANGE("A" & r).value = rs!FieldOne & ""
	    r = r + 1 'next row.....
	
	    rs.MoveNext
	Loop
	
	rs.Close
	Set rs = Nothing

    End With

    
    'PROCESS THE LIVE TABLE
    '-------------------------------------------------------------------------------------------------
    With objXls.Sheets(2)
	'since you already know what the columns are, just define them here. For example.
	r = 6
        'code here....
    End With    
    
    'PROCESS THE ARCHIVE TABLE
    '-------------------------------------------------------------------------------------------------
    With objXls.Sheets(3)
	'since you already know what the columns are, just define them here. For example.
	r = 6
        'code here....
    End With    
    

    objXls.Save
    Set objXls = Nothing
    xlsApp.Visible = True

    CreateCloseExcelApplication False, False
                            
End Sub

Put this in a module.

Code:
'MODULE - EXCEL OBJECT

Public xlsApp As Excel.Application

Public Sub CreateCloseExcelApplication(ByVal bCreate As Boolean, Optional ByVal bQuit As Boolean = False, Optional ByVal bExcelVisiable As Boolean = False)

    On Error Resume Next
    
    If bCreate = True Then
        
        Set xlsApp = GetObject(, "Excel.Application")
        
        If Err.Number > 0 Then
            
            Set xlsApp = CreateObject("Excel.Application")
            
            If xlsApp Is Nothing Then
                gobjErrorMessages.Add 1000, "ExcelObject", "Could Not Create An Excel Object"
            Else
                xlsApp.Visible = bExcelVisiable
            End If
        Else
            xlsApp.Visible = bExcelVisiable
        End If
    
    Else
        
        If bQuit = True Then
            xlsApp.Quit
        End If
        
        Set xlsApp = Nothing
    
    End If
    
End Sub
 

Users who are viewing this thread

Top Bottom