Exporting a table to excel

[jln via AccessMonster.com]

I need to program this in VBA. What it needs to do is export a table into
excel from the click event of a form.

 

[Roger Carlson]

There are a number of ways to do this, depending on exactly what you are
trying to accomplish. On my website (www.rogersaccesslibrary.com), is a
small Access database sample called "ExportToExcel.mdb" which illustrates
one way.

--
--Roger Carlson
MS Access MVP
Access Database Samples: www.rogersaccesslibrary.com
Want answers to your Access questions in your Email?
Free subscription:
http://peach.ease.lsoft.com/scripts/wa.exe?SUBED1=ACCESS-L

 

[Guest]

Look in VBA Help for the TransferSpreadsheet method.

 

[jln via AccessMonster.com]

I took a look at the example and I guess what i need is to export to excel
the data as you would see it in Access headers and all. No formatting of the
data unless if wouldnt look the same as what you see in Access.

 

[Guest]

'put this code in a form event
Private Sub button_Click()
Dim sql as String
Dim rs as ADODB.Recordset
'change the query to select from your database
sql = "SELECT Drivers.* FROM Drivers WHERE Drivers.DriverId > 0;"
set rs = KeySet_Rs(sql)
ExportExcel "c:\excelfiles", "filename.xls", rs
rs.close
set rs = nothing

End Sub


'******************************************************************
'put this code below in a module

'If your using only access use CurrentProject.Connection as the connection
string
Public Function Connect() As String
Connect = Application.CurrentProject.Connection
End Function


' Returns Disconnected Keyset Recordset
Public Function KeySet_Rs(sql As String) As ADODB.recordset
Dim rs As ADODB.recordset
Set rs = New ADODB.recordset
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.CursorType = adOpenKeyset
rs.Open sql, Connect()
rs.ActiveConnection = Nothing
Set KeySet_Rs = rs
End Function


'Exports a recordset to Excel
Public Sub ExportExcel(path As String, filename As String, rs As
ADODB.recordset)
Dim objXL As Object
Set objXL = CreateObject("Excel.Application")
objXL.Visible = False 'Set to true if you want to see it
objXL.Workbooks.Add 'creates new empty worksheet in excel

Dim row As Long, column As Long
column = 1
row = 1
With objXL.Application
Do While Not (rs.EOF Or rs.BOF)
If row = 1 Then
For column = 0 To rs.Fields.count - 1 'Get Header Row with
Field Names
.ActiveSheet.cells(row, column + 1).value =
rs.Fields(column).Name
.ActiveSheet.cells(row, column + 1).Borders.Weight =
xlMedium
.ActiveSheet.cells(row, column + 1).Interior.ColorIndex
= 15
.ActiveSheet.cells(row, column + 1).Interior.Pattern = 1
.ActiveSheet.cells(row, column +
1).Interior.PatternColorIndex = xlAutomatic
Next
row = row + 1
End If
For column = 0 To rs.Fields.count - 1 'Loop through
recordset and insert all the records into excel
Dim str As String
str = IIf(IsNull(rs.Fields(column)), "", rs.Fields(column))
If Len(str) > 0 Then
If IsDate(str) Then
.ActiveSheet.cells(row, column + 1).NumberFormat =
"mm/dd/yyyy hh:mm:ss AM/PM"
End If
End If
.ActiveSheet.cells(row, column + 1).value = rs.Fields(column)
.ActiveSheet.cells(row, column + 1).Borders.Weight = xlThin
Next
row = row + 1
rs.MoveNext
Loop
.ActiveSheet.Columns("A:ZZ").AutoFit
End With

If Not PathExists(path) Then
MkDir path
End If
objXL.ActiveWorkbook.SaveAs path & "\" & filename
objXL.Quit 'Remove this if you want to leave Excel Open
Set objXL = Nothing
End Sub