Solved: Excel to access cell for cell import

[White_Nova]

Hi All

Please would you be so kind as to tell me where im going wrong?

I have a form in excel that writes to an excel sheet, in the VBA(Below), i have requested the cells update a access database.

however i get an error when trying to run it (Try it...)

Sub Paymentinput()
' exports data from the active worksheet to a table in an Access database

Dim db As Database
Dim rs As Recordset

Set db = OpenDatabase(ActiveWorkbook.Path & "\DataStore.mdb")

' open the database

Set rs = db.OpenRecordset("1", dbOpenTable)
' get all records in a table

Sheets("Database").Select

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("ID") = range("A2").Value
.Fields("Manager") = range("B2").Value
.Fields("Date") = range("C2").Value
.Fields("Session") = range("D2").Value
.Fields("Lead Number") = range("E2").Value
.Fields("Surname") = range("F2").Value
.Fields("Consultant") = range("G2").Value
.Fields("Prize") = range("H2").Value
.Fields("Chosen Number") = range("I2").Value
.Fields("Actual Number") = range("J2").Value
.Fields("Start Time") = range("K2").Value
.Fields("End Time") = range("L2").Value
.Fields("Difference") = range("M2").Value



' add more fields if necessary...
.update 'stores the new record
End With


rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

range("A2").Select
ActiveCell.FormulaR1C1 = ""
range("B2").Select
ActiveCell.FormulaR1C1 = ""
range("C2").Select
ActiveCell.FormulaR1C1 = ""
range("D2").Select
ActiveCell.FormulaR1C1 = ""
range("E2").Select
ActiveCell.FormulaR1C1 = ""
range("F2").Select
ActiveCell.FormulaR1C1 = ""
range("G2").Select
ActiveCell.FormulaR1C1 = ""
range("H2").Select
ActiveCell.FormulaR1C1 = ""
range("I2").Select
ActiveCell.FormulaR1C1 = ""
range("J2").Select
ActiveCell.FormulaR1C1 = ""
range("K2").Select
ActiveCell.FormulaR1C1 = ""
range("L2").Select
ActiveCell.FormulaR1C1 = ""
range("M2").Select
ActiveCell.FormulaR1C1 = ""


range("A2").Select

End Sub


Please see if you can help....!!!!

Many thanks

[White_Nova]

Just some extra info, bot the Excel and Access docs are in the same folder, i have a feeling it has something to do with the References in VBA but have tried all of them...

[Charlize]

[VBA]Sub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
'Store is the name of your datatable in DataStore.mdb
'If table has different name, use that name
'And I'm not sure about the format the data must have.
'Maybe they have to be all in string format ?
sSQL = "INSERT INTO Store (ID, Manager,Date, Session) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
Range("A2:M2").ClearContents
End Sub
[/VBA]

[White_Nova]

Hi Charlize

Many thanks, i do however get an error on this line...
oConn.Execute sSQL

[Charlize]

Hi Charlize

Many thanks, i do however get an error on this line...
oConn.Execute sSQL

Describe the error.

[White_Nova]

Run-Time Error '-2147217900 (80040e14):'

Syntax Error in INSERT INTO Statement.

[Charlize]

I believe it's got something to do with your Date as fieldname (maybe even ID and Session). It seems to me that they are close to reserved keywords. When I renamed them to MyId, MyDate and MySession the adding took place.

[White_Nova]

That seems to working 100% Charlize thanks, 1 thing though, the form in excel does not work... but its a data manager for Excel, can you help?

[White_Nova]

h

[White_Nova]

Hi Charlize

The full line of data is not pulling through to Access.
i have ammended the code provided a little, please tell me where im going wrong?

Sub PaymentInput()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (MYID, TIMEIN, MYDATE, MYSESSION, MANAGER, LEADNUMBER, CONSULTANT, PRIZE, ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, DIFFERENCE) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "','" & [E2] & "','" & [F2] & "','" & [G2] & "','" & [H2] & "','" & [I2] & "','" & [J2] & "','" & [K2] & "','" & [L2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End Sub

[Charlize]

Provide me your testdata so that I can take a look at the setup.

So, the excelfile with coding + line of data that's not fully copied into acces and your acces database you want to use that has the table already defined the way you want it to be.

For the moment it's like holding a wet finger in the wind (if you get my point).

ps. if you post coding you can apply the VBA tags (that green square with vba in it) around those coding. It's a lot easier to read like that.

[White_Nova]

Excel VBA below
Excel file attached


[VBA]
Sub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (TIMEIN, MYDATE, MYSESSION,MANAGER, LEADNUMBER, CONSULTANT, PRIZE, ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, DIFFERENCE, SURNAME) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "','" & [E2] & "','" & [F2] & "','" & [G2] & "','" & [H2] & "','" & [I2] & "','" & [J2] & "','" & [K2] & "','" & [L2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing

End Sub
[/VBA]

Your a huge help

[Charlize]

Where is your database ?

[Charlize]

Everything seems to work fine for me. A little modification to pass string values to the database. The MYDATE field in the database is declared as a Date/Time value ? Anyway, here the coding[VBA]Sub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (TIMEIN, MYDATE, MYSESSION, MANAGER, " & _
"LEADNUMBER, CONSULTANT, PRIZE, " & _
"ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, " & _
"DIFFERENCE, SURNAME) " & _
"VALUES ('" & [A2].Text & "','" & [B2].Text & "','" & [C2].Text & _
"','" & [D2].Text & "','" & [E2].Text & "','" & [F2].Text & _
"','" & [G2].Text & "','" & [H2].Text & "','" & [I2].Text & _
"','" & [J2].Text & "','" & [K2].Text & "','" & [L2].Text & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End Sub[/VBA]

[White_Nova]

Hi Charlize

Working 100%!!!
Thanks a mil...

Is there a way to specify what the type of info is that you sending accross (i.e Date/Time, Text, Numbers)???

[Charlize]

Everything must be sent over as a string. The value of the cell can be date, number, string, whatever type. And the cell is formatted as we want it to see. But we use the .Text property instead of the .Value property. It's because we are building a commandstring to be executed to achieve the result we want, namely adding info to a database. The database has the configuration of the field. If you declare mydate as a date/time field then the string that you sent over to the database will become a date/time type of info for the database.

If you want to retrieve info from the database, I think that you need a variable declared as a date otherwise you'll get an error (unless you put it directly into a worksheet).

[White_Nova]

You an absolute champion Charlize!!!!!

I have tried this code to pull the Access query back to Excel but get the following error : User Defined Type not Defined.

[VBA]Sub GetCn()
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbfile & ";", _
"", ""
Set dbrs = New ADODB.Recordset
dbrs.Open sqlstr, dbcon
End Sub


Sub Access()
Dim adoconn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim SQL As String
Dim filenm As String

SQL = "Select * From Store"
filenm = (ActiveWorkbook.Path & "\DataStore.mdb")
Call GetCn(adoconn, adors, SQL, filenm, "", "")

Dim xlSht As Excel.Worksheet
Set xlSht = Sheets("Access")
xlSht.Range("B2").CopyFromRecordset adors
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Set xlSht = Nothing

End Sub[/VBA]

Please help.....

[Charlize]

This one will do something to fetch all the data from store and put it in worksheet no 3. You have to set a reference (early binding). If I have more time i'll try to convert it to late binding.

ps.: This is a quick and dirty way but you get the results you want. It could be that some lines of coding aren't really necessary.[VBA]Sub GetData()
'You have to set a reference to
'microsoft dao 3.6 object library
'Tested under excel 2003
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Long
Dim MyPath As String

Set Ws = Worksheets(3)
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code
MyPath = ActiveWorkbook.Path & "\DataStore.mdb"
'This set of code will activate Sheet3 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyPath, ReadOnly:=True)
'This will set the RecordSet to all records in the Store table
Set Rs = Db.OpenRecordset("Store")
'Set Rs = _
'Db.OpenRecordset("SELECT * FROM Store WHERE Mydate = '08/11/2007';")
'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and
'auto-fit the columns
Ws.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Ws.Range("A1").Select
Rs.Close
Db.Close
End Sub[/VBA]

[White_Nova]

You are an angel in desguise Charlize!!!!!

[White_Nova]

Please remind me to send you some flowers and a box of chocolates!!!!