J
Jack
Hi,
I have a code that is applied in excel vba. This code imports an access
table to excel. However I want to export an access table to excel.
Can the following code be tweaked to export from access to excel.
Specifically I am looking for looping through a recordset and export the data
to excel. Thanks.
Sub GetAccessTableData()
' Sample demonstrating how to return a recordset from an Access db
' does not require a reference to the Microsoft ActiveX Data Objects
Library as it's late bound
Dim cnn As Object, strQuery As String, rst As Object
Dim strPathToDB As String, i As Long
Dim wks As Worksheet
Dim lngNextNum As Long, lngRow As Long, lngCol As Long
Dim varData
Const adOpenStatic As Long = 3
Const adLockPessimistic As Long = 2
Const adCmdTable As Long = 2
' output to activesheet
Set wks = ActiveSheet
' Path to database
' strPathToDB = "C:\test\Test1.mdb"
strPathToDB = "c:\_0__AccessExcel\test.mdb"
Set cnn = CreateObject("ADODB.Connection")
' open connection to database
With cnn
.ConnectionTimeout = 500
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & strPathToDB & ";"
.Open
.CommandTimeout = 500
End With
' SQL query string - change to suit
' strQuery = "Table1"
strQuery = "employees"
' create new recordset
Set rst = CreateObject("ADODB.Recordset")
' open recordset using query string and connection
With rst
.Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdTable
' check for records returned
If Not (.EOF And .BOF) Then
'Populate field names
For i = 1 To .Fields.Count
wks.Cells(1, i) = .Fields(i - 1).Name
Next i
' Copy data from A2
lngRow = 2
Do Until .EOF
For lngCol = 1 To .Fields.Count
wks.Cells(lngRow, lngCol) = .Fields(lngCol - 1).Value
Next lngCol
.MoveNext
lngRow = lngRow + 4
Loop
End If
.Close
End With
' clean up
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
I have a code that is applied in excel vba. This code imports an access
table to excel. However I want to export an access table to excel.
Can the following code be tweaked to export from access to excel.
Specifically I am looking for looping through a recordset and export the data
to excel. Thanks.
Sub GetAccessTableData()
' Sample demonstrating how to return a recordset from an Access db
' does not require a reference to the Microsoft ActiveX Data Objects
Library as it's late bound
Dim cnn As Object, strQuery As String, rst As Object
Dim strPathToDB As String, i As Long
Dim wks As Worksheet
Dim lngNextNum As Long, lngRow As Long, lngCol As Long
Dim varData
Const adOpenStatic As Long = 3
Const adLockPessimistic As Long = 2
Const adCmdTable As Long = 2
' output to activesheet
Set wks = ActiveSheet
' Path to database
' strPathToDB = "C:\test\Test1.mdb"
strPathToDB = "c:\_0__AccessExcel\test.mdb"
Set cnn = CreateObject("ADODB.Connection")
' open connection to database
With cnn
.ConnectionTimeout = 500
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & strPathToDB & ";"
.Open
.CommandTimeout = 500
End With
' SQL query string - change to suit
' strQuery = "Table1"
strQuery = "employees"
' create new recordset
Set rst = CreateObject("ADODB.Recordset")
' open recordset using query string and connection
With rst
.Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdTable
' check for records returned
If Not (.EOF And .BOF) Then
'Populate field names
For i = 1 To .Fields.Count
wks.Cells(1, i) = .Fields(i - 1).Name
Next i
' Copy data from A2
lngRow = 2
Do Until .EOF
For lngCol = 1 To .Fields.Count
wks.Cells(lngRow, lngCol) = .Fields(lngCol - 1).Value
Next lngCol
.MoveNext
lngRow = lngRow + 4
Loop
End If
.Close
End With
' clean up
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub