I am using the following code to import data from access file and it is working well.
Code: Select all
Sub ImportData()
Dim a, strSQL As String, i As Long
Application.ScreenUpdating = False
strSQL = "SELECT * FROM StudentData ORDER BY student_code"
With ThisWorkbook.Worksheets("Sheet1")
.UsedRange.Offset(1).ClearContents
ImportFromAccessTable ThisWorkbook.Path & "\filename.mdb", strSQL, .Range("A2")
a = .Range("A1").CurrentRegion.Value
.Range("A1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Application.ScreenUpdating = True
MsgBox "Data Imported", vbInformation, "Done"
End Sub
Sub ImportFromAccessTable(sPath As String, SQL As String, rngTarget As Range)
Dim cnn As ADODB.Connection, rs As ADODB.Recordset
On Error GoTo ErrHandler:
Application.ScreenUpdating = False
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sPath
Set rs = New ADODB.Recordset
rs.Open SQL, cnn
If rs.EOF And rs.BOF Then
rs.Close: cnn.Close
Set rs = Nothing: Set cnn = Nothing
MsgBox "There Are No Records In The Recordset!", vbCritical, "No Records": Exit Sub
End If
rngTarget.CopyFromRecordset rs
rs.Close: cnn.Close
Set rs = Nothing: Set cnn = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
ErrHandler:
Set rs = Nothing: Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") In Procedure ImportFromAccessTable"
End Sub