Export two tables to one excel worksheet with a different range

mjdavie

Registered User.
Local time
Today, 20:12
Joined
Sep 17, 2001
Messages
34
Hi,

I have used the code below to export my table to a specific range and worksheet in excel which works fine.

However I would like to export another table to a different range in the same worksheet in excel in the same code.

Could somebody help me update this code in order to do this I have tried various permitations as well as running the code twice with different variables but can't get it to work.

Any help would be appreciated

Code:
Public Function Sendtowsheet1(strTName As String, strSheetName As String, strFilepath As String, strRange As String)

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set xlx = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0


' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True


Set xlw = xlx.Workbooks.Open(strFilepath)

Set xls = xlw.Worksheets(strSheetName)

Set xlc = xls.Range(strRange)

Set dbs = CurrentDb()

Set rst = dbs.OpenRecordset(strTName)

If rst.EOF = False And rst.BOF = False Then

      rst.MoveFirst

      If blnHeaderRow = True Then
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
            Next lngColumn
            Set xlc = xlc.Offset(1, 0)
      End If

      ' write data to worksheet
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
End If
rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
   ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing



End Function
 

Users who are viewing this thread

Back
Top Bottom