Export specific fields from access to Excel

[Abhijeet Gudur]

Cells(1, 8) contains full path&name of access db ex: C:\dbfolder\test.accdb
Main is the table in access.


'This macro requires ADO X.X Object Library reference
Sub GetDBData()
Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range

DBFullName = Cells(1, 8)

On Error GoTo errfetch

Application.ScreenUpdating = False
Range("A4:V20000").ClearContents
Set TargetRange = ActiveSheet.Range("A4")

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & DBFullName & ";"

Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT [header1],[header2],[header3],[header4] FROM Main ", cn, , , adCmdText

' Write the field names
'For intColIndex = 0 To rs.Fields.Count - 1
'TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
'Next

' Write recordset
TargetRange.CopyFromRecordset rs

LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
errfetch:
MsgBox "Error Description :" & Err.Description & vbCrLf & _
"Error at line :" & Erl & vbCrLf & _
"Error Number :" & Err.Number
Resume LetsContinue
End Sub