Hello Good People,
Please help as my code is return an error 438: Object does not support this method or property.
I'm trying to import data from an access spreadsheet to excel. I'm not sure of what to do regarding the object error.Please see the code below:
Option Explicit
Sub Import_Data_Access_2007()
Const stDB As String = "c:\users\dedo\documents\Northwind 2007.accdb"
Const stWholeTable As String = "Shippers"
Const stSQL As String = "SELECT Company,City FROM Shippers" & _
"WHERE [Country Region] ='USA'"
Const stStoredReport As String = "Order Summary"
On Error GoTo Error_Handling
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rs As DAO.Recordset
Dim wbTarget As Workbook
Dim wsOrders As Worksheet
Dim wsShippers As Worksheet
Dim wsProducts As Worksheet
Dim rnOrders As Range
Dim rnShippers As Range
Dim rnProducts As Range
Dim lnCounter As Long
Set wbTarget = ActiveWorkbook
With wbTarget
Set wsOrders = .Worksheet(1)
Set wsShippers = .Worksheet(2)
Set wsProducts = .Worksheet(3)
End With
Set rnOrders = wsOrders.Range("A2")
Set rnShippers = wsShippers.Range("A2")
Set rnProducts = wsProducts.Range("A2")
Set db = OpenDatabase(stDB)
Set tdf = db.TableDefs(stWholeTable)
Set rs = tdf.OpenRecordset(dbOpenTable)
Application.ScreenUpdating = False
For lnCounter = 0 To rs.Fields.Count - 1
wsShippers.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnShippers.CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset(stSQL, dbOpenSnapshot)
For lnCounter = 0 To rs.Fields.Count - 1
wsProducts.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnProducts.CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset(stStoredReport, dbOpenForwardOnly)
For lnCounter = 0 To rs.Fields.Count - 1
wsOrders.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnOrders.CopyFromRecordset rs
rs.Close
db.Close
MsgBox "All data has been successfully transfered.", vbOKOnly
ExitSub:
Set rs = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Sub
Error_Handling:
MsgBox "Error number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbOKOnly
Resume ExitSub
End Sub
ANY SUGGESTIONS PLEASE
Please help as my code is return an error 438: Object does not support this method or property.
I'm trying to import data from an access spreadsheet to excel. I'm not sure of what to do regarding the object error.Please see the code below:
Option Explicit
Sub Import_Data_Access_2007()
Const stDB As String = "c:\users\dedo\documents\Northwind 2007.accdb"
Const stWholeTable As String = "Shippers"
Const stSQL As String = "SELECT Company,City FROM Shippers" & _
"WHERE [Country Region] ='USA'"
Const stStoredReport As String = "Order Summary"
On Error GoTo Error_Handling
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rs As DAO.Recordset
Dim wbTarget As Workbook
Dim wsOrders As Worksheet
Dim wsShippers As Worksheet
Dim wsProducts As Worksheet
Dim rnOrders As Range
Dim rnShippers As Range
Dim rnProducts As Range
Dim lnCounter As Long
Set wbTarget = ActiveWorkbook
With wbTarget
Set wsOrders = .Worksheet(1)
Set wsShippers = .Worksheet(2)
Set wsProducts = .Worksheet(3)
End With
Set rnOrders = wsOrders.Range("A2")
Set rnShippers = wsShippers.Range("A2")
Set rnProducts = wsProducts.Range("A2")
Set db = OpenDatabase(stDB)
Set tdf = db.TableDefs(stWholeTable)
Set rs = tdf.OpenRecordset(dbOpenTable)
Application.ScreenUpdating = False
For lnCounter = 0 To rs.Fields.Count - 1
wsShippers.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnShippers.CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset(stSQL, dbOpenSnapshot)
For lnCounter = 0 To rs.Fields.Count - 1
wsProducts.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnProducts.CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset(stStoredReport, dbOpenForwardOnly)
For lnCounter = 0 To rs.Fields.Count - 1
wsOrders.Cells(1, lnCounter + 1).Value = rs.Fields(lnCounter).Name
Next lnCounter
rnOrders.CopyFromRecordset rs
rs.Close
db.Close
MsgBox "All data has been successfully transfered.", vbOKOnly
ExitSub:
Set rs = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Sub
Error_Handling:
MsgBox "Error number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbOKOnly
Resume ExitSub
End Sub
ANY SUGGESTIONS PLEASE