Help Me Understand This Code

[davidnash]

Dim rstComment As Recordset
Dim strCriteria As String

Set rstComment = CurrentDb.OpenRecordset(Me.OpenArgs)
strCriteria = strItem & " = " & nNumber & " AND ProgressionID = " & cboProgressionID

With rstComment
.AddNew
![CommentNo] = DCount("CommentNo", Me.OpenArgs, strCriteria)
.Fields(strItem) = nNumber
![ProgressionID] = Me![cboProgressionID]
![Comment] = Me![txtComment]
![PersID] = 0 'Will be changed by SQL Server
![Date] = Now() 'Will be changed by SQL Server
.Update
.Close
End With

This code is used in a form that is accessed via a main form when a progression is selected. The form that opens allows the user to selct a type of progression and to enter a comment. This data is then transferred to a table.

I get an error:

Error No:3184 Couldn't execute query; couldn't find linked table.

This form is used elsewhere in the database and works fine. The code is exactly the same. The form name is different and the table it points to is the same design of table as the other but obviously named differently. i am confident it is referenced correctly. But you lot are the experts.

I am not trained in VBA and have only just started to understand bits of it.


Cheers All

 

[reclusivemonkey]

Is it a function or a subroutine?

 

[davidnash]

This is the forms complete code:


Option Compare Database
Option Explicit

Private Sub cmdCancel_Click()
On Error GoTo Err_cmdCancel_Click

DoCmd.Close ' closes the frmEnterComment form

Exit_cmdCancel_Click:
Exit Sub

Err_cmdCancel_Click:

Beep
MsgBox Err.Description, vbInformation, "cmdCancel_Click"
Resume Exit_cmdCancel_Click

End Sub

Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click
'this checks that all the fields are entered and then saves the data

If IsNull(Me![cboProgressionID]) Then
Beep
DoCmd.Hourglass False
MsgBox "Select a position for the comment", vbInformation
Me![cboProgressionID].SetFocus
Exit Sub

Else

If IsNull(Me![txtComment]) Then
Beep
DoCmd.Hourglass False
MsgBox "A comment must be entered", vbInformation
Me![txtComment].SetFocus
Exit Sub

Else

Dim rstComment As Recordset
Dim strCriteria As String

Set rstComment = CurrentDb.OpenRecordset(Me.OpenArgs)
strCriteria = strItem & " = " & nNumber & " AND ProgressionID = " & cboProgressionID

With rstComment
.AddNew
![CommentNo] = DCount("CommentNo", Me.OpenArgs, strCriteria)
.Fields(strItem) = nNumber
![ProgressionID] = Me![cboProgressionID]
![Comment] = Me![txtComment]
![PersID] = 0 'Will be changed by SQL Server
![Date] = Now() 'Will be changed by SQL Server
.Update
.Close
End With

End If
End If

DoCmd.Close

Exit_cmdOK_Click:
DoCmd.Hourglass False
Exit Sub

Err_cmdOK_Click:

DoCmd.Hourglass False

If Err.Number >= 3146 And Err.Number <= 3157 Then 'Obtain SQL Server error message
ProcessSQLError
Else
Beep
MsgBox "Error No :" & Err.Number & " " & Err.Description, vbInformation, "cmdOK_Click"
End If

Resume Exit_cmdOK_Click

End Sub

Private Sub Form_Open(Cancel As Integer)
'This Sub displays in the drop down the next required progressions

Dim strSQL As String

strSQL = "SELECT ProgressionID, Progression FROM tblPinProgressionTitle WHERE ProgressionID IN ("
'Base available progressions on last one made.
'SQL will check nonetheless anyway

If Not IsNull(Forms!frmUPinDetails!txtCxdShortTgtDate) Then ' allows addition of changed target date comment
strSQL = strSQL & "1900)"

ElseIf Not IsNull(Forms!frmUPinDetails!txtCxdLongTgtDate) Then ' allows addition of changed target date comment
strSQL = strSQL & "2000)"

ElseIf Not IsNull(Forms!frmUPinDetails!txtCxdEvidenceTgtDate) Then ' allows addition of changed target date comment
strSQL = strSQL & "2100)"

ElseIf LongTermActionRequired.value = -1 Then ' if long term action is required

Select Case [Status]
Case 500 'qm rejected
strSQL = strSQL & "300,1700,1800)"
Case 600 'oc approval
strSQL = strSQL & "800,1700,1800)"
Case 700 'oc rejected
strSQL = strSQL & "300,1700,1800)"
Case 1000 'check of short term actions satis
strSQL = strSQL & "900,1700,1800)"
Case 1600 'PIN actions not effective
strSQL = strSQL & "300,1700,1800)"
End Select

ElseIf LongTermActionRequired.value = 0 Then ' if long term action is not required you can't select long term stuff

Select Case [Status]
Case 500 'qm rejected
strSQL = strSQL & "300,1700,1800)"
Case 600 'oc approval
strSQL = strSQL & "800,1700,1800)"
Case 700 'oc rejected
strSQL = strSQL & "300,1700,1800)"
Case 1000 'check of short term actions satis
strSQL = strSQL & "1400,1700,1800)"
Case 1600 'PIN actions not effective
strSQL = strSQL & "300,1700,1800)"

End Select

Else

Select Case [Status]
' these progressions do not depend on long term action required
Case 0 ' new PIN raised it defaults to 0
strSQL = strSQL & "100)"
Case 100 'originator
strSQL = strSQL & "150,160,1700)"
Case 150 'nature and extent
strSQL = strSQL & "150,160,1700,1800)"
Case 160 'nature and extent final
strSQL = strSQL & "170,180,1700,1800)"
Case 170 'root causes
strSQL = strSQL & "170,180,1700,1800)"
Case 180 'root causes final
strSQL = strSQL & "300,1700,1800)"
Case 300 'short and long term plan
strSQL = strSQL & "400,500,1700,1800)"
Case 400 'qm accepted
strSQL = strSQL & "600,700,1700,1800)"
Case 800 'short term actions
strSQL = strSQL & "1000,1100,1700,1800)"
Case 900 'long term actions
strSQL = strSQL & "1200,1300,1700,1800)"
Case 1100 'check of short term actions unsatis
strSQL = strSQL & "800,1700,1800)"
Case 1200 'check of long term actions satis
strSQL = strSQL & "1400,1700,1800)"
Case 1300 'check of long term actions unsatis
strSQL = strSQL & "900,1700,1800)"
Case 1400 'evidence review
strSQL = strSQL & "1500,1600,1700,1800)"
Case 1500 'PIN actions effective
strSQL = strSQL & "1700,1800)"
End Select

End If

cboProgressionID.RowSource = strSQL
cboProgressionID.Requery

End Sub

 

[reclusivemonkey]

I suspect the problem is with the "OpenArgs" part of the code. Have a look at the code that opens the form. Better still, ask whoever wrote it ;-)

 

[davidnash]

I can't speak to the lad that wrote it because he is abroad. He's back next week; I just wanted to get on with it. I realise it's something to do with the OpenArgs. I am resourseful, so hopefully I will suss it out before he comes back. My boss and the QA man have put a case together now, so I am hopeful I might get a course out of this. problem for them is that I am out of the RAF in Jun so they don't want to spend money on me. But, if they want their database out then they have to spend money. Thanks for your help.