specific cells from Excel to Access (1 Viewer)

iamstupid

New member
Local time
Today, 10:18
Joined
May 25, 2011
Messages
7
Hey guys ,
i am trying to extract data from the specific excel cells to store into my access database. however, i have no idea how about i should be doing this ..
any advice would be greatly appreciated !
 

Trevor G

Registered User.
Local time
Today, 03:18
Joined
Oct 1, 2009
Messages
2,341
Look to use a MACRO and you will see that you can use TransferSpreadSheet and you can set the range of cells.

I just noted this is from Excel to Access, look at this code

Sub ExcelToAccess()
'You must set the reference to Access
'Tools Menu, References and then look for Microsoft Access, tick the box
' exports data from the active worksheet
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 'Change Path and Database name
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable) 'Add your table name
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value 'Change to Field name
.Fields("FieldName2") = Range("B" & r).Value 'Change to Field name
.Fields("FieldNameN") = Range("C" & r).Value 'Change to Field name
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
 

iamstupid

New member
Local time
Today, 10:18
Joined
May 25, 2011
Messages
7
right i just tried using it but i have an error . my codes are as followed :

Sub ExportExcelToAccess()
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("Q:\Aaron\NotesDB-edit.mdb")
Set rs = db.OpenRecordset(tblEDS, dbOpenTable)
r = 210 ' where the row start
Do While Len(Range("B" & r).Formula) > 0 ' repeat until empty cell
'Add new records into db
With rs
.AddNew
.Fields(EDSEndDate) = Range("B" & r)
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

however there is an error on "Set rs = db.OpenRecordset(tblEDS, dbOpenTable)" stating there is Run time error '3011' Microsoft Jet Database engine could not find the object. Make sure the object exists and that you spell its name and the path name correctly.

But my table is called tblEDS , and my path is correct ! Any advice ?
 

Trevor G

Registered User.
Local time
Today, 03:18
Joined
Oct 1, 2009
Messages
2,341
Place speech marks around the table name and the field name

Set rs = db.OpenRecordset("tblEDS", dbOpenTable)
 

iamstupid

New member
Local time
Today, 10:18
Joined
May 25, 2011
Messages
7
this time it states an error stating Run time error 13 , type mismatch
 

Trevor G

Registered User.
Local time
Today, 03:18
Joined
Oct 1, 2009
Messages
2,341
I have recreated a table in a sample database using the same table name you are using and also some fields and including your field name. I have set the Reference in the VBA screeen to use ADO (Tools > References > Scrolldown to Microsoft ActiveX Data Objects 6.0 Library)

Then I have used this code and it works

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=M:\Access Files\Test ME Today.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tblEDS", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Regions") = Range("A" & r).Value
.Fields("Names1") = Range("B" & r).Value
.Fields("EDSEndDate") = Range("E" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
 

Users who are viewing this thread

Top Bottom