Help Fixing Code - Edit Access table from Excel

[Little Penny]

I trying to get the below code that I found at the following link:

http://vbadud.blogspot.com/search/label/Programmatically update Database tables

I'm looking to use a macro via excel to update\edit a record in an
access table. The code below should select the table named
"tbl_Sample" and update the record with a UniqueID of 5 and change the
JobName field to "Success"

Lots of Problem.
Here are the errors I get.

1. Provider cannot be found it may not be properly installed
2. Requested operation requires an OLE DB Session object, which
is not supported by the current provider
3. The connection cannot be used to perform this operation. It is
either closed or invalid in this context
I'm looking for help to get the thing to work.


Thanks Little Penny



My Code:

Sub SampleUpdate()


Dim cn As ADODB.Connection '* Connection String

Dim oCm As ADODB.Command '* Command Object

Dim uID As Long

Dim nJN As String

Dim iRecAffected As Integer



On Error GoTo ADO_ERROR


Set cn = New ADODB.Connection

cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Sample\SampleData.mdb;Persist Security Info=False"

cn.ConnectionTimeout = 40

cn.Open



uID = 5

nJN = 12345


Set oCm = New ADODB.Command

oCm.ActiveConnection = cn

oCm.CommandText = "Update tbl_StreamLine Set JobName = 'Test' Where
ID= '5'"

oCm.CommandText = "Update tbl_Sample Set JobNumber ='" & nJN & "'
where UniqueID='" & uID & "'"


oCm.Execute iRecAffected




If iRecAffected = 0 Then

MsgBox "No records inserted"

End If


If cn.State <> adStateClosed Then

cn.Close

End If






Application.StatusBar = False

If Not oCm Is Nothing Then Set oCm = Nothing

If Not cn Is Nothing Then Set cn = Nothing


ADO_ERROR:

If Err <> 0 Then

'Debug.Assert Err = 0

MsgBox Err.Description

Err.Clear

Resume Next

End If

End Sub

 

[joel]

Lets start simple to solve yor problem. I would record a macro from excel
while performing a Data query. This will get you started in the right
direction.

1) Start Recording - Tools - Macro - Record New Macro
2) Data - Import External Data - New Databae Query
3) Select MS Access and browse for your database
4) Select the correct table from your databae and choose the filed you want
to reference.
5) Stop Recording tools - Macro - Stop recording.


You know have the correct syntax for you macro. Use the fields from the
recorded macro in you original code and try again.

If you still have errors then try opening up the Database and make sure it
is not corrupted. I think more of your code will start working. let me know
if you still are having problems. I should be able to help. Post both your
updated macro and the recorded macro so I can see what changes you made.

 

[LittlePenny]

Below are the recorded macro and the updated macro. In the updated
macro I changed change the SQL statement to an Update query. When I
run the macro I get: Syntax error in Update statement. If I it ok
another MSBOX say no record updated .

Thanks




Recorded Macro

Macro1 Macro
'

'
With ActiveSheet.ListObjects.Add(SourceType:=0,
Source:=Array(Array( _
"ODBC;DSN=MS Access
Database;DBQ=C:\Sample\SampleData.mdb;DefaultDir=C:\Sample;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeo" _
), Array("ut=5;")),
Destination:=Range("$1:$65536")).QueryTable
.CommandText = Array( _
"SELECT tbl_Sample.UniqueID, tbl_Sample.JobNumber,
tbl_Sample.JobName" & Chr(13) & "" & Chr(10) & "FROM
`C:\Sample\SampleData.mdb`.tbl_Sample tbl_Sample" & Chr(13) & "" &
Chr(10) & "WHERE (tbl_Sample.UniqueID=5)" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName =
"Table_Query_from_MS_Access_Database"
.Refresh BackgroundQuery:=False
End With
End Sub




Updated Macro


Sub SampleUpdate01()


Dim cn As ADODB.Connection '* Connection String

Dim oCm As ADODB.Command '* Command Object

Dim uID As Long

Dim nJN As String

Dim iRecAffected As Integer



On Error GoTo ADO_ERROR


Set cn = New ADODB.Connection

cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Sample\SampleData.mdb;Persist Security Info=False"

cn.ConnectionTimeout = 40

cn.Open



uID = 5

nJN = "Success"


Set oCm = New ADODB.Command

oCm.ActiveConnection = cn



oCm.CommandText = "Update tbl_Sample.UniqueID, Set
tbl_Sample.JobNumber, tbl_Sample.JobName" & Chr(13) & "" & Chr(10) &
"FROM `C:\Sample\SampleData.mdb`.tbl_Sample tbl_Sample" & Chr(13) & ""
& Chr(10) & "WHERE (tbl_Sample.UniqueID=5)"



oCm.Execute iRecAffected




If iRecAffected = 0 Then

MsgBox "No records inserted"

End If


If cn.State <> adStateClosed Then

cn.Close

End If






Application.StatusBar = False

If Not oCm Is Nothing Then Set oCm = Nothing

If Not cn Is Nothing Then Set cn = Nothing


ADO_ERROR:

If Err <> 0 Then

'Debug.Assert Err = 0

MsgBox Err.Description

Err.Clear

Resume Next

End If

End Sub

 

[joel]

I did two things to get rid of errors

1) Long lines wrap so I shorten the lines by breaking the strings into
multiple lines using the line continuation character

2) You need to Add two references to the VBA window from the menu

Tools - References
Check the following items and then click OK

Microsoft Access 11.0 object library (or higheest number)
Micorsoft ActiveX Data objects 2.8 library (or highest number)

I check the changes you made and I pretty sure the code should work. The
only thing I'm not sure of is the connection string. Not familiar with the
provider and I haven't used the "Persist Security Info=False" option before.

I went to the ACCESS VBA help and "Persist Security Info" is a valid ADO
option oso that should work. I'll asume you got the server name from a
reliable source.

Sub SampleUpdate01()


Dim cn As ADODB.Connection '* Connection String

Dim oCm As ADODB.Command '* Command Object

Dim uID As Long

Dim nJN As String

Dim iRecAffected As Integer



On Error GoTo ADO_ERROR


Set cn = New ADODB.Connection

cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Sample\SampleData.mdb;" & _
"Persist Security Info=False"

cn.ConnectionTimeout = 40

cn.Open



uID = 5

nJN = "Success"


Set oCm = New ADODB.Command

oCm.ActiveConnection = cn



oCm.CommandText = "Update tbl_Sample.UniqueID, " & _
"Set tbl_Sample.JobNumber, " & _
"tbl_Sample.JobName" & Chr(13) & "" & Chr(10) & _
"FROM `C:\Sample\SampleData.mdb`.tbl_Sample tbl_Sample" & _
Chr(13) & Chr(10) & "WHERE (tbl_Sample.UniqueID=5)"



oCm.Execute iRecAffected




If iRecAffected = 0 Then

MsgBox "No records inserted"

End If


If cn.State <> adStateClosed Then

cn.Close

End If






Application.StatusBar = False

If Not oCm Is Nothing Then Set oCm = Nothing

If Not cn Is Nothing Then Set cn = Nothing


ADO_ERROR:

If Err <> 0 Then

'Debug.Assert Err = 0

MsgBox Err.Description

Err.Clear

Resume Next

End If

End Sub

 

[LittlePenny]

Thanks for your help Joel...

I added the two references and used your modified code. I'm still
getting the "Syntax error in update statement".

Should I re-record the macro again.

 

[LittlePenny]

Thanks for your help....

I've made all the changes however I'm getting:

Syntax error in UPDATE statement.

Should I record the macro again?

 

[Mike]

Try this. If you are using a 2007 database then its not .mdb its .accdb
Sub SampleUpdate()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim uID As Long, nJN

uID = 5
nJN = 12345

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Database2.accdb;"
Set cnn = New ADODB.Connection
cnn.Open strConn

sSQL = "UPDATE tbl_StreamLine SET tbl_StreamLine.JobName =" _
& "'Test' WHERE (((tbl_StreamLine.ID)=5));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn
sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobNumber =" _
& "" & nJN & " WHERE (((tbl_Sample.UniqueID)=" & uID & "));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn
cnn.Close
Set cnn = Nothing

End Sub

 

[LittlePenny]

It works...


How can I get the code to pass a string.

I want the code to change the value to "Today"

My Code


Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim uID As Long
Dim nJN As String

uID = 5
nJN = Today

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Sample\SampleData.mdb;"
Set cnn = New ADODB.Connection
cnn.Open strConn

sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobName =" _
& "'nJN' WHERE (((tbl_Sample.UniqueID)=5));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn

cnn.Close
Set cnn = Nothing

End Sub

 

[joel]

try this code. shoudl today have double quotes or is it a date. The single
quotes may need to get removed. what I did is similer to getting the last row
of a range in the worksheets

LastRow = Range("A" & rows.count).end(xlup).row
Range("A1:A" & LastRow).copy

--------------------------------------------------------------------------------

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim uID As Long
Dim nJN As String

uID = 5
nJN = Today

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Sample\SampleData.mdb;"
Set cnn = New ADODB.Connection
cnn.Open strConn

sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobName =" _
& "'" & nJN & "' WHERE (((tbl_Sample.UniqueID)=" & uID & "));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn

cnn.Close
Set cnn = Nothing

End Sub

 

[Mike]

Try this
Sub SampleUpdate()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim uID As Long
Dim nJN As String

uID = 5
nJN = "#" & Date & "#"

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Database2.accdb;"
Set cnn = New ADODB.Connection
cnn.Open strConn

sSQL = "UPDATE tbl_StreamLine SET tbl_StreamLine.JobName =" _
& "'Test' WHERE (((tbl_StreamLine.ID)=5));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn
sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobNumber =" _
& "" & nJN & " WHERE (((tbl_Sample.UniqueID)=" & uID & "));"
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn
cnn.Close
Set cnn = Nothing

End Sub

 

[LittlePenny]

Thanks again for all your help. I need to apologize for two things.
1. Posting the same thing twice.
2. Not being clear on my last post.

"How can I get the code to pass a string? I want the code to change
the value to "Today"

Using "today" was a bad example.

What I want to do is pass a string, for example the word "Microsoft".
I tried to edit the syntax but of course it did not work. My goal is
once we get this to work us values from cell on a spreadsheet to
update the database.

I started to do this by using (uID = Range("A1").Value) in the code.
Code work fine.. If I try to use (nJN = Range("B1").Value) in the code
also works find. But when use the value in C1 with something other
than a number like the work "Microsoft" I get an error

A1 = 3 (UniqueID) Works fine
B1 = 123456 (Job Number) Works fine
C1 = Microsoft (Job Name) If I have 2 sql statements it ignores the
updating of the Job Name. If ignore update the job number:

'Update Job Number
sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobNumber =" _
& "" & nJN & " WHERE (((tbl_Sample.UniqueID)=" & uID & "));"

I get this error:

run-time error'-2147217904 (80040e10)':
"No Value given for one or more requires parameters"

My Code (Hope this make sense)


Sub FinalUpdate05()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String, strConn
Dim uID As Long, nJN
Dim nJBN As String


uID = Range("A1").Value 'Unique Id Value


nJN = Range("B1").Value ' Job Number Value


nJBN = Range("C1").Value ' Job Name Value




strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=C:\Sample\SampleData.mdb;"

Set cnn = New ADODB.Connection
cnn.Open strConn

'Update Job Name
sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobName =" _
& "" & nJBN & " WHERE (((tbl_Sample.UniqueID)=" & uID & "));"


'Update Job Number
sSQL = "UPDATE tbl_Sample SET tbl_Sample.JobNumber =" _
& "" & nJN & " WHERE (((tbl_Sample.UniqueID)=" & uID & "));"


Set rs = New ADODB.Recordset
rs.Open sSQL, cnn
cnn.Close
Set cnn = Nothing

End Sub

 

[LittlePenny]

I got it.............

Thanks Joel and Mike



Your the Best....