Sample Code for Exporting to Excel (1 Viewer)

wilderfan

Registered User.
Local time
Today, 15:34
Joined
Mar 3, 2008
Messages
172
No responses from last week, so I'll try again.

I'd like to export the contents of a recordset to an existing Excel file.

Ideally, I'd like to open a connection to that Excel file and loop through the 1st recordset and copy its contents into a 2nd recordset linked to the Excel file.

Does anyone have some sample code that illustrates this sort of scenario?
 

gblack

Registered User.
Local time
Today, 23:34
Joined
Sep 18, 2002
Messages
632
I found this:

Code:
Private Sub SaveRecordsetToExcelRange()

  '  Excel constants:
  Const strcXLPath As String = "C:\\MyData\MyWorkbook.xls"
  Const strcWorksheetName As String = "Sheet1"
  Const strcCellAddress As String = "A1"
  
  '  Access constants:
  Const strcQueryName As String = "MyQuery"
  
  '  Excel Objects:
  Dim objXL As Excel.Application
  Dim objWBK As Excel.Workbook
  Dim objWS As Excel.Worksheet
  Dim objRNG As Excel.Range
  
  '  DAO objects:
  Dim objDB As DAO.Database
  Dim objQDF As DAO.QueryDef
  Dim objRS As DAO.Recordset
  
  
  On Error GoTo Error_Exit_SaveRecordsetToExcelRange
  
  '  Open a DAO recordset on the query:
  Set objDB = CurrentDb()
  Set objQDF = objDB.QueryDefs(strcQueryName)
  Set objRS = objQDF.OpenRecordset
  
  '  Open Excel and point to the cell where
  '  the recordset is to be inserted:
  Set objXL = New Excel.Application
  objXL.Visible = True
  Set objWBK = objXL.Workbooks.Open(strcXLPath)
  Set objWS = objWBK.Worksheets(strcWorksheetName)
  Set objRNG = objWS.Range(strcCellAddress)
  objRNG.CopyFromRecordset objRS
  
  '  Destroy objects:
  GoSub CleanUp
  
Exit_SaveRecordsetToExcelRange:

  Exit Sub
  
CleanUp:

  '  Destroy Excel objects:
  Set objRNG = Nothing
  Set objWS = Nothing
  Set objWBK = Nothing
  Set objXL = Nothing
  
  '  Destroy DAO objects:
  If Not objRS Is Nothing Then
    objRS.Close
    Set objRS = Nothing
  End If
  Set objQDF = Nothing
  Set objDB = Nothing
  
  Return
  
Error_Exit_SaveRecordsetToExcelRange:

  MsgBox "Error " & Err.Number _
    & vbNewLine & vbNewLine _
    & Err.Description, _
    vbExclamation + vbOKOnly, _
    "Error Information"
    
  GoSub CleanUp
  Resume Exit_SaveRecordsetToExcelRange

End Sub

Here:http://social.msdn.microsoft.com/Forums/office/en-US/adf2dc3f-d43e-451f-ad58-5617865b1e82/access-2007-using-vba-to-export-a-table-or-recordset-into-excel-2007?forum=accessdev
 

sumox

Registered User.
Local time
Tomorrow, 04:04
Joined
Oct 1, 2013
Messages
89
I found this:

Code:
Private Sub SaveRecordsetToExcelRange()
 
  '  Excel constants:
  Const strcXLPath As String = "C:\\MyData\MyWorkbook.xls"
  Const strcWorksheetName As String = "Sheet1"
  Const strcCellAddress As String = "A1"
 
  '  Access constants:
  Const strcQueryName As String = "MyQuery"
 
  '  Excel Objects:
  Dim objXL As Excel.Application
  Dim objWBK As Excel.Workbook
  Dim objWS As Excel.Worksheet
  Dim objRNG As Excel.Range
 
  '  DAO objects:
  Dim objDB As DAO.Database
  Dim objQDF As DAO.QueryDef
  Dim objRS As DAO.Recordset
 
 
  On Error GoTo Error_Exit_SaveRecordsetToExcelRange
 
  '  Open a DAO recordset on the query:
  Set objDB = CurrentDb()
  Set objQDF = objDB.QueryDefs(strcQueryName)
  Set objRS = objQDF.OpenRecordset
 
  '  Open Excel and point to the cell where
  '  the recordset is to be inserted:
  Set objXL = New Excel.Application
  objXL.Visible = True
  Set objWBK = objXL.Workbooks.Open(strcXLPath)
  Set objWS = objWBK.Worksheets(strcWorksheetName)
  Set objRNG = objWS.Range(strcCellAddress)
  objRNG.CopyFromRecordset objRS
 
  '  Destroy objects:
  GoSub CleanUp
 
Exit_SaveRecordsetToExcelRange:
 
  Exit Sub
 
CleanUp:
 
  '  Destroy Excel objects:
  Set objRNG = Nothing
  Set objWS = Nothing
  Set objWBK = Nothing
  Set objXL = Nothing
 
  '  Destroy DAO objects:
  If Not objRS Is Nothing Then
    objRS.Close
    Set objRS = Nothing
  End If
  Set objQDF = Nothing
  Set objDB = Nothing
 
  Return
 
Error_Exit_SaveRecordsetToExcelRange:
 
  MsgBox "Error " & Err.Number _
    & vbNewLine & vbNewLine _
    & Err.Description, _
    vbExclamation + vbOKOnly, _
    "Error Information"
 
  GoSub CleanUp
  Resume Exit_SaveRecordsetToExcelRange
 
End Sub
Here:http://social.msdn.microsoft.com/Fo...-or-recordset-into-excel-2007?forum=accessdev

WHY \\double slashes ?? in FilePAthname?
 

Users who are viewing this thread

Top Bottom