Solved: Updating an access record from an excel userform (excel '97)

[phendrena]

Hi there,

I currently have setup a data entry userform in excel and also a record search userform in excel. While I can get the data into and out of Access i am stuck on how to code an update routine.

Would anyone be able to provide some suggestions?

Thanks,

[Bob Phillips]

What are you using, ADO?

If so, her is an example



Sub UpdateData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim oConn As Object
Dim oRS As Object
Dim sConnect As String
Dim sSQL As String
Dim ary

sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "c:\bob.mdb"

sSQL = "SELECT * From Contacts"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If oRS.EOF Then
MsgBox "No records returned.", vbCritical
Else
sSQL = "UPDATE Contacts " & _
" SET Phone = 'None' " & _
"WHERE FirstName = 'Bob' AND LastName = 'Phillips'"
oRS.ActiveConnection.Execute sSQL

sSQL = "SELECT * From Contacts"
oRS.ActiveConnection.Execute sSQL
ary = oRS.getrows
MsgBox ary(0, 0) & " " & ary(1, 0) & ", " & ary(2, 0)
End If


oRS.Close
Set oRS = Nothing
End Sub

[phendrena]

Hi xld,

A very quick reply!
Yes I am using ADO.
I'll give your code a whirl and let you know.

Thanks,

[Bob Phillips]

Hi xld,

A very quick reply!

Straight from my archives.

[phendrena]

Hi xld,

I've amended the code as below :-
Sub UpdateData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim oConn As Object
Dim oRS As Object
Dim sConnect As String
Dim sSQL As String
Dim ary
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "S:\BTeams\Affinity\Affinity Support Team\Operations\Toyota Lexus\Drive away\3 day drive home\Database\Toyota Lexus Web Log Database.mdb"
sSQL = "SELECT * From WebLogData"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If oRS.EOF Then
MsgBox "No records returned.", vbCritical
Else
sSQL = "UPDATE WebLogData " & _
"SET WebLogData.Comments = '" & Me.txtComments.Value & "'" & _
"WHERE WebLogData.DateOfCall = '" & Me.txtDate.Value & "' AND WebLogData.ID = '" & Me.txtID.Value & "'"
oRS.ActiveConnection.Execute sSQL

sSQL = "SELECT * From WebLogData"
oRS.ActiveConnection.Execute sSQL
ary = oRS.GetRows
MsgBox ary(0, 0) & " " & ary(1, 0) & ", " & ary(2, 0)
End If

oRS.Close
Set oRS = Nothing
End Sub

When I try the routine it errors with : 'Data type mismatch in criteria expression'.
Debug highlights : 'oRS.ActiveConnection.Execute sSQL'

Any suggestions?

Thanks,

[Bob Phillips]

I would guess it is the date causing a problem, try



sSQL = "UPDATE WebLogData " & _
"SET WebLogData.Comments = '" & Me.txtComments.Value & "'" & _
"WHERE WebLogData.DateOfCall = #" & Format(Me.txtDate.Value, "dd-mmm-yyyy") & _
"# AND WebLogData.ID = '" & Me.txtID.Value & "'"

[phendrena]

I would guess it is the date causing a problem, try



sSQL = "UPDATE WebLogData " & _
"SET WebLogData.Comments = '" & Me.txtComments.Value & "'" & _
"WHERE WebLogData.DateOfCall = #" & Format(Me.txtDate.Value, "dd-mmm-yyyy") & _
"# AND WebLogData.ID = '" & Me.txtID.Value & "'"


Hi xld,

Thanks for the suggestion.
Still no joy i'm afraid.
I've also tried to change it from being based on the date of call and record id (autonumber) to a persons name and record ID (autonumber) :-

"WHERE WebLogData2.CustomerManager = '" & Me.txtCM.Value & "' AND WebLogData2.ID = '" & Me.txtID.Value & "'"

I'm still getting the same error :(
I've attached a copy of the database and spreadsheet if you want to have a look.

Thanks,

[Bob Phillips]

password?

[phendrena]

d'oh!
I thought i'd stripped the passwords!
As usual, p1neapple and 0range (vba).

[Bob Phillips]

Which is the update button, I can only see an Add?

[Kenneth Hobs]

Nice looking userform phendrena (http://vbaexpress.com/forum/member.php?u=18427).

XLD, you will need to open the userform and set the button's visible to True. It is the pink button on the bottom right. Change the constant's path for sConnect. Delete the sConnect string in the UpdateData(). When you play the userform, select the button Search-> and the pink button will then show. Click Find to fill the box. The pink button should then act on a selected row (record) in the box.

If xld has not fixed the sql string by the time I get back to it, I will look at this in more detail.

[phendrena]

Sorry guys, i really should've made everything a tad more accessible when posting. /slap

[Kenneth Hobs]

This seemed to work for me. Notice that I changed your constants to private variables. I set the variable values in the initialize event. In your sql string, I removed the single quotes around the id number.

I did not do anything with dates since you did not seem to be using it.

Obviously, you need a bit more error checking to be sure that something is there to be found and the first row is not selected.

Private glob_sdbPath As String
Private glob_sConnect As String

Private Sub cmdUpdateSelected_Click()
Call UpdateData
End Sub


'---------------------------------------'
'-- Initalise Routine --'
'---------------------------------------'


Private Sub UserForm_Initialize()
'glob_sdbPath = "x:\_VBA Express\Toyota Lexus Web Log Database.mdb"
glob_sdbPath = "S:\BTeams\Affinity\Affinity Support Team\Operations\Toyota Lexus\Drive away\3 day drive home\Database\Toyota Lexus Web Log Database.mdb"
glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & glob_sdbPath & ";"

Set ws = Worksheets("Menu")

Me.StartUpPosition = 0
Me.Top = 125
Me.Left = 125

Me.Width = 255
Me.Height = 350

cboValidate.List = WorksheetFunction.Transpose(ws.Range("Answers"))
cboIssue.List = WorksheetFunction.Transpose(ws.Range("Answers"))

Me.txtCM.Value = Application.UserName
Me.txtDealerNo.SetFocus

Me.txtDate.Value = Format(Date, "dd/mm/yyyy")

cmdUpdate.Enabled = True
End Sub

'------------------------------------------'
'------ Update Record ----'
'------------------------------------------'


Private Sub UpdateData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim oConn As Object
Dim oRS As Object
Dim sConnect As String
Dim sSQL As String
Dim ary

sConnect = glob_sConnect
sSQL = "SELECT * From WebLogData2"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If oRS.EOF Then
MsgBox "No records returned.", vbCritical
Else
sSQL = "UPDATE WebLogData2 " & _
"SET WebLogData2.Comments = '" & Me.txtComments.Value & "' " & _
"WHERE WebLogData2.CustomerManager = '" & Me.txtCM.Value & "' AND WebLogData2.ID = " & Me.txtID.Value
oRS.ActiveConnection.Execute sSQL

sSQL = "SELECT * From WebLogData2"
oRS.ActiveConnection.Execute sSQL
ary = oRS.GetRows
MsgBox ary(0, 0) & " " & ary(1, 0) & ", " & ary(2, 0)
End If

oRS.Close
Set oRS = Nothing
End Sub

[phendrena]

Excellent, that does indeed work.

Thank you :)

[phendrena]

Going back to this one for a moment.
I've taken the above code and have now amended it for a different userform, however the code doesn't want to work for me. It is now giving and SQL Error : Syntax error (missing operator) in query expression '7DaySupport.CustomerManager = 'David Bandey' AND 7DaySupport.PolicyRegNo = DU09ALO'

The full SQL statement shows as : UPDATE 7DaySupport SET 7DaySupport.7DayTeamActioned = 'No' WHERE 7DaySupport.CustomerManager = 'David Bandey' AND 7DaySupport.PolicyRegNo = DU09ALO

I personally suspect it wants '' around DU09ALO, but i've also added them and i still get the same error.

Private Sub UpdateData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim oConn As Object
Dim oRS As Object
Dim sConnect As String
Dim sSQL As String
Dim ary

On Error GoTo ErrHandler

sConnect = glob_sConnect
sSQL = "SELECT * From 7DaySupport"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If oRS.EOF Then
MsgBox "No records returned.", vbCritical
Else
sSQL = "UPDATE 7DaySupport " & _
"SET 7DaySupport.7DayTeamActioned = '" & Me.cboActioned.Value & "' " & _
"WHERE 7DaySupport.CustomerManager = '" & Me.txtCM.Value & "' AND 7DaySupport.PolicyRegNo = " & Me.txtPolReg.Value
oRS.ActiveConnection.Execute sSQL

sSQL = "SELECT * From 7DaySupport"
oRS.ActiveConnection.Execute sSQL
ary = oRS.GetRows
'MsgBox ary(0, 0) & " " & ary(1, 0) & ", " & ary(2, 0)
MsgBox "Record Updated"
End If

oRS.Close
Set oRS = Nothing

Exit Sub
ErrHandler:
MsgBox sSQL

End Sub

[Bob Phillips]

"WHERE 7DaySupport.CustomerManager = '" & Me.txtCM.Value & "' AND 7DaySupport.PolicyRegNo = '" & Me.txtPolReg.Value & "'"

[phendrena]

"WHERE 7DaySupport.CustomerManager = '" & Me.txtCM.Value & "' AND 7DaySupport.PolicyRegNo = '" & Me.txtPolReg.Value & "'"


Hi xld,

I'm still getting a syntax error :-
Syntax error (missing operator) in query expression '7DaySupport.CustomerManager = 'David Bandey' AND 7DaySupport.PolicyRegNo = 'DU09ALO''

Any further thoughts?

Thanks,

[Bob Phillips]

You are missing the final single quote. I think my example is right, so you might have mis-transcribed it.

[phendrena]

You are missing the final single quote. I think my example is right, so you might have mis-transcribed it.
Am I? I just highlighted your code and copy/pasted tbh. As far as I can tell looks correct :-
sSQL = "UPDATE 7DaySupport " & _
"SET 7DaySupport.7DayTeamActioned = '" & Me.cboActioned.Value & "' " & _
"WHERE 7DaySupport.CustomerManager = '" & Me.txtCM.Value & "' AND 7DaySupport.PolicyRegNo = '" & Me.txtPolReg.Value & "'"
oRS.ActiveConnection.Execute sSQL Of course i could be missing the obvious, i often do!

[Bob Phillips]

No you are right, I misread the two single quotes at the end as one double quote.

[Bob Phillips]

Other than that, by sight it looks fine to me.

[phendrena]

Alright then, i have put [] around the SQL tables/items and it works now.

[Bob Phillips]

Can you show me what you mean?

[phendrena]

Hi xld,

Here you go :


sSQL = "UPDATE [7DaySupport] " & _

"SET [7DaySupport].[7DayTeamActioned] = '" & Me.cboActioned.Value & "' " & _

"WHERE [7DaySupport].[CustomerManager] = '" & Me.txtCM.Value & "' AND [7DaySupport].[PolicyRegNo] = '" & Me.txtPolReg.Value & "'"
oRS.ActiveConnection.Execute sSQL

[Bob Phillips]

That's very odd, I don't do that with Access.

What happens if you use




"SET 7DayTeamActioned = '" & Me.cboActioned.Value & "' " & _
"WHERE CustomerManager = '" & Me.txtCM.Value & "' AND PolicyRegNo = '" & Me.txtPolReg.Value & "'"

oRS.ActiveConnection.Execute sSQL