update Access table Query from Excel 2010

[amolwa]

i am new in VBA and Access. i am trying to develop application using forum helps. i am fetching data from MS access table in excel using IPR_ID field (multiple records for one IPR_ID (Sr No field is set as Primary Key in access Database.)) and displaying it in Userform with Active cell value which works fine but at the same time i would like to update access database AD_State field for same IPR_ID with LOCKED status to lock records for others to View or Edit fetched records. update Active row excell cells from Userform and from excel to Access Database table with AD_State UNLOCKED Below is the Find Records click button code in Find_Rec userform Sub CommandButton1_Click() Dim cnt As ADODB.Connection Dim rst1 As ADODB.Recordset Dim wsSheet1 As Worksheet 'Instantiate the ADO-objects. Set cnt = New ADODB.Connection Set rst1 = New ADODB.Recordset Set wbBook = ThisWorkbook Set wsSheet1 = wbBook.Worksheets(1) 'Path to the database. stDB = "R:\Claims\MS Access Database\Claims.accdb" 'Create the connectionstring. stConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & stDB & ";" 'The 1st raw SQL-statement to be executed. stSQL1 = "SELECT * FROM Payables_Output where IPR_ID = '" & TextBox1 & "' And AD_State = 'UnLocked'" 'Clear the worksheet. ThisWorkbook.Sheets(1).Range("A1").CurrentRegion.Offset(1).Clear With cnt .Open (stConn) 'Open the connection. .CursorLocation = adUseClient 'Necessary to disconnect the recordset. End With With rst1 .Open stSQL1, cnt 'Create the recordset. Set .ActiveConnection = Nothing 'Disconnect the recordset. End With With ThisWorkbook.Sheets(1) .Cells(2, 1).CopyFromRecordset rst1 'Copy the 1st recordset. End With 'Release objects from the memory. rst1.Close Set rst1 = Nothing ' rst2.Close ' Set rst2 = Nothing cnt.Close Set cnt = Nothing 'update AD Status to lock records for others to view and update stSQL2 = "update Payables_output set Ad_State = 'Locked' where IPR_ID= '" & TextBox1 & "'" If Not Range("A2").Value = "" Then ThisWorkbook.Sheets(1).Range("A2").Select FindRec.Hide Module3.show_records Module3.label_Header Rec_Viewer.Show Else MsgBox "No Records Found for IPR " & TextBox1 ThisWorkbook.Sheets(1).Range("A1").CurrentRegion.Offset(1).Clear FindRec.Show End If End Sub

[Ken Puls]

This seems like a statement, rather than a question. Is something not working? What? Do you get an error? What is it?

We'll need a bit more about what the problem is before we can help you here.

[amolwa]

First thnx so much for lukin into this
Fetching records frm excel works fine but update query statement is nt working. I am not getting any error i debug code in break mode copy printed statement of update query put it into acees sql view and amzingly its working fine in access
But why its nt wrking frm excel wts wrong in my code..

This seems like a statement, rather than a question. Is something not working? What? Do you get an error? What is it?

We'll need a bit more about what the problem is before we can help you here.

[Ken Puls]

You're using ADO, and sometimes the SQL syntax is slightly different. I can't recall if this is one case of it or not, but try replacing each instance of ' with two " and see if that goes:

stSQL2 = "update Payables_output set Ad_State = ""Locked"" where IPR_ID= """ & TextBox1 & """"

[amolwa]

Hi,

i tried this but still not working debug.print shows update Payables_output set Payables_output.[Ad_State] = "Locked" where Payables_output.IPR_ID= " & FindRec.TextBox1 & "

Previous debug.print statement shows update Payables_output set Payables_output.[Ad_State] = 'Locked' where Payables_output.IPR_ID= 'DIE02111400549'

[Ken Puls]

I assume you're doing this through a userform, correct?

I created a very simple userform with just a commandbutton and a textbox on it. Then added the following code to the userform:

Private Sub CommandButton1_Click()
    Dim stSQL2 As String
    stSQL2 = "update Payables_output set Ad_State = ""Locked"" where IPR_ID= """ & TextBox1.Value & """"
    Debug.Print stSQL2
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    TextBox1.Value = "DIE02111400549"
End Sub

Running the userform then clicking the commandbutton leaves me with the following in the Immediate window:

update Payables_output set Ad_State = "Locked" where IPR_ID= "DIE02111400549"

Are you sure you got the correct number of quotes on yours, as it seems like there may be one extra on either side of the textbox section...

[amolwa]

Hi,

Yes i am doing it through userform
i am getting same result; i am so sorry i think i was doing something wrong earlier, update Payables_output set Payables_output.[Ad_State] = "Locked" where Payables_output.IPR_ID= "DIE02111400549"
but from excel its still not updating database.so i try to update databse from access query with above statement and it works

[Ken Puls]

Shoot, you know, I just looked at some ADO stuff, and you were right with the single quote, back up to what you had there (apologies for leading you down the path on that one.) I do notice that you set your SQL statement near the end, but you never seem to actually do anything with it. Is that all of your code? If not, can you post the part that actually commits that string into the database? Also, tell me a bit more about the error you're getting.

[amolwa]

i am using 3 forms.1-Fetch records from Access to Excel 2-Display Records from Excel to User Form and 3-a Calender.

as i told you earlier i am not getting any error it executes complete code and ends normally but does not update Access Table with Locked Status. This is where i stucked, i have other stuff to do but moving slowly. next step is when i click on Save Records Button records should be saved in Access Table with ID which primary key in database from Excel.

the above given code is for Fetch records from Access to Excel with Textbox and FindRecords Command button

Below code is for Displaying Records from Excel to User Form

Private Sub CmdEditRecords_Click()

For b = 24 To 42
Rec_Viewer.Controls("TextBx" & b).Enabled = True
Next

CmdEditRecords.Enabled = False
CmdSaveRecords.Enabled = True
End Sub


Private Sub CmdSaveRecords_Click()
Module3.update_Data

For b = 24 To 42
Rec_Viewer.Controls("TextBx" & b).Enabled = False
Next

CmdEditRecords.Enabled = True
CmdSaveRecords.Enabled = False
End Sub


Private Sub PreviousBtn_Click()
On Error Resume Next
If NextBtn.Enabled = False Then
NextBtn.Enabled = True
End If

If ActiveCell.Offset(-2).Row = 1 Then
PreviousBtn.Enabled = False
Else
PreviousBtn.Enabled = True
End If

If Not Cells(ActiveCell.Row, 1).Row = 2 Then
Cells(ActiveCell.Row - 1, 1).Select
Module3.show_records
End If
End Sub


Private Sub NextBtn_Click()

If PreviousBtn.Enabled = False Then
PreviousBtn.Enabled = True
End If

If ActiveCell.Offset(2).Value = "" Then
NextBtn.Enabled = False
Else
NextBtn.Enabled = True
End If

If Not Cells(ActiveCell.Row, 1).Offset(1).Value = "" Then
Cells(ActiveCell.Row + 1, 1).Select
Module3.show_records
End If

End Sub


Private Sub TextBx30_enter()
frmCalendar.Show
'frmCalendar.Move TextBx30.Left, TextBx30.Top + TextBx30.Height
End Sub


Private Sub TextBx40_ENTER()
frmCalendar.Show
End Sub


Private Sub UserForm_Terminate()
FindRec.Show
ThisWorkbook.Sheets(1).Range("A1").CurrentRegion.Offset(1).Clear
End Sub

for Calender form

Private Sub cmdClose_Click()
frmCalendar.Hide
Unload frmCalendar
End Sub


Private Sub UserForm_activate()
frmCalendar.Move Rec_Viewer.ActiveControl.Left + 111, Rec_Viewer.ActiveControl.Top + 85 + Rec_Viewer.ActiveControl.Height
frmCalendar.Calendar1.Value = Date
End Sub


Private Sub UserForm_Initialize()
If IsNull(Rec_Viewer.ActiveControl) Then
Me.Calendar1.Value = Date
Else
Me.Calendar1.Value = ActiveControl
End If
End Sub


Private Sub Calendar1_DblClick()
Rec_Viewer.ActiveControl = Format(frmCalendar.Calendar1.Value, "dd-mmm-yyyy")
frmCalendar.Hide
Unload frmCalendar
End Sub

below is Module3 code

Sub show_records()
a = ActiveCell.Row
'If a = 1 Then CommandButton2.Enabled = False
For i = 1 To 42
Rec_Viewer.Controls("TextBx" & i).Value = Cells(a, Col + i)
Rec_Viewer.Controls("TextBx" & i).Enabled = False
Rec_Viewer.Controls("TextBx" & i).WordWrap = True
Rec_Viewer.Controls("TextBx" & i).AutoSize = True
Rec_Viewer.Controls("TextBx" & i).Font.Name = "Arial"
Rec_Viewer.Controls("TextBx" & i).Font.Size = 10
Rec_Viewer.Controls("TextBx" & i).AutoSize = True

' If Len(Rec_Viewer.Controls("TextBx" & i).Text) > 1 Then
' Rec_Viewer.Controls("TextBx" & i).Width = Len(Rec_Viewer.Controls("TextBx" & i).Text) * 10 - 20

Next
End Sub


Sub label_Header()
With ThisWorkbook.Sheets(1).Range("A1:AP1")
For i = 1 To 42
Rec_Viewer.Controls("Label" & i).Caption = Cells(1, Col + i)
Rec_Viewer.Controls("Label" & i).Font.Name = "Arial"
Rec_Viewer.Controls("Label" & i).Font.Size = 9.5
Next
End With
End Sub


Sub update_Data()
With ThisWorkbook.Sheets(1)
Cells.Find(what:=Rec_Viewer.TextBx1.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True).Activate
For i = 1 To 42
Cells(ActiveCell.Row, Col + i) = Rec_Viewer.Controls("Textbx" & i).Value
Next
End With
End Sub

[Ken Puls]

What I'm saying though, if you read the first sub you posted carefully, you do this:

• Create the first SQL string
• Open the database connection, create a recordset
• Pass the SQL string to retrieve the recordset
• Disconnect from the database

Next, you create the strSQL2 string, but that's as far as you go. I can't see anything in any of your code where you actually re-open the database connection and push that SQL command back to the database. That would be why the VBA is completing, but the records aren't being updated.

Does that makes sense?