Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need VB help to export data to Excel Workbook Tabs 2

Status
Not open for further replies.

roaml

Technical User
Feb 19, 2002
264
US
Hi All,

Does anyone have VB code to export data from Access (2000) to Excel and place the data in particular tabs within a workbook?

 
Here's a short example:
Code:
Function OutputToSpreadsheet(ByVal strFile As String, _
                             ByVal intSheet As Integer, _
                             ByVal strTable As String, _
                             ByVal strStartCell As String) As Long
On Error GoTo ErrHandler
  
  'Excel stuff
  Dim xl As Excel.Application
  Dim wb As Excel.Workbook
  Dim sht As Excel.Worksheet
  Dim rng As Excel.Range
  Dim lngRow As Long
  Dim lngCol As Long
  
  'Table stuff
  Dim rst As Recordset
  
  If Dir(strFile) = "" Then
    GoTo ExitHere
  End If
  
  Set rst = CurrentDb.OpenRecordset(strTable)
  
  If rst.RecordCount > 0 Then
    
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Open(strFile, Editable:=True, AddToMRU:=False)
    Set sht = wb.Sheets(intSheet)
    
    'Get Row and Column indexes
    lngRow = sht.Range(strStartCell).row
    lngCol = sht.Range(strStartCell).Column
    
    sht.Activate
    
    'If header cells exist, increment row number or
    'add header row dynamically using rst.Fields(x).Name.
    
    'This example doesn't include header row.
    Set rng = sht.Range(sht.Cells(lngRow, lngCol), sht.Cells(lngRow, lngCol + rst.Fields.Count - 1))
    
    'Must have blank adjacent rows to prevent selecting other cells
    rng.CurrentRegion.Select
    
    'Clear old data
    xl.Selection.Clear
    
    'Insert new data
    rng.CopyFromRecordset rst
    
    'Remove region selection
    sht.Range("A1").Select
  
  End If

  'Return total records exported
  OutputToSpreadsheet = rst.RecordCount
    
ExitHere:
  On Error Resume Next
  wb.Close True
  xl.Quit
  Set rng = Nothing
  Set sht = Nothing
  Set wb = Nothing
  Set xl = Nothing
  Exit Function
ErrHandler:
  MsgBox "Error: " & Err & " - " & Err.Description
  Resume ExitHere
End Function

VBSlammer
redinvader3walking.gif

[sleeping]Unemployed in Houston, Texas
 
Check the Range argument of the TransferSpreadsheet method of the DoCmd object:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, "TableOrQueryName", "C:\Location\XLFile.xls", True, "SheetName"

HTH



[pipe]
Daniel Vlas
Systems Consultant

 
Thank you VBSammer and Daniel for your assistance. I now have someting to work with.

Thanks again!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top