R
RockyIII
Used a database without anyproblems. But when Database Backend was migrated
to SQL 2000, then everytime I try to append records or insert records ot a
table, I get this error.
ANy idea how ot get a permenant solution. All help appreciated (See Below)
sorry for the lengthy code:
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++
Private Sub cmdCreate_Click()
On Error GoTo Err_cmdCreate_Click
Dim cnn1 As ADODB.Connection
Dim rstRevInfo, rstTagNumbers As ADODB.Recordset
Dim dbCS As Database
Dim rstAddEditIssue, rstInstrTable, rstSpecs, rstInstruments, rstDelete
As Recordset
Dim sqlAddEditIssue, sqlInstrTable, sqlRevInfo, sqlSpecs, sqlInstruments,
sqlTagNumbers, sqlDelete, sqlInstrPrint As String
Dim iReport, iResponse, iInstr As Integer
Dim bInstrSelect, bSpecFormMatch As Boolean
'Cycles through the items in the lstInstrIssue list box and checks to see if
any instruments are selected
'If any are selected, sets a boolean flag, bInstrSelect, to true and exits
the For... Next loop
bInstrSelect = False
For iInstr = 0 To lstInstrIssue.ListCount - 1
If lstInstrIssue.Selected(iInstr) Then
bInstrSelect = True
Exit For
End If
Next iInstr
'If no issue is selected in the cboIssueNo control, a message box is shown
and the sub is exited
If IsNull(fraIssueInfo) Or (fraIssueInfo = 1 And (IsNull(txtIssueNumber)
Or IsNull(txtIssueDate) Or IsNull(txtDescription))) Or (fraIssueInfo = 2 And
IsNull(cboIssueNo.Column(0))) Then
Call MsgBox("Please complete Issue Information.", vbOKOnly +
vbExclamation)
Exit Sub
'If no instruments are selected in the lstInstrIssue control, as noted by
the bInstrSelect flag,
'a message box is shown and the sub is exited
ElseIf bInstrSelect = False Then
Call MsgBox("Please select at least one instrument.", vbOKOnly +
vbExclamation)
Exit Sub
'Generates the cover sheet if an issue number and instruments are selected
Else
DoCmd.OpenForm "frmMessageCreate" 'Flashes Message that alerts user
that report is generating
Set dbCS = CurrentDb
If fraIssueInfo = 1 Then
'If the "Create New Issue" option, optAddIssue, is selected then it
creates an record for the general cover sheet
'information in the tblIssues table
sqlAddEditIssue = "INSERT INTO tblIssues
(project_id,spec_form_id,rev_type,issue_no,issue_date," & _
"issue_description,instr_engr,package_no) VALUES (" & iProjectID
& "," & cboSpecForm.Column(0) & _
"," & fraIssueType & ",'" & txtIssueNumber & "',#" &
txtIssueDate & "#,'" & txtDescription & _
"','" & txtInstrEngr & "'," & txtPackageNo & ")"
dbCS.Execute sqlAddEditIssue
'Creates a recordset containing the record that was just added to the
issues table and sets that record as the
'rowsource for the Issue Number combo box. This is done to make the
following code identical for both creating
'and appending issues.
sqlAddEditIssue = "SELECT DISTINCT * FROM tblIssues WHERE
project_id=" & iProjectID & " AND spec_form_id=" & _
cboSpecForm.Column(0) & " AND rev_type=" & fraIssueType & " AND
issue_no='" & txtIssueNumber & "' AND issue_date=#" & _
txtIssueDate & "# AND issue_description='" & txtDescription & "'
AND instr_engr='" & txtInstrEngr & "' AND package_no=" & txtPackageNo
Set rstAddEditIssue = dbCS.OpenRecordset(sqlAddEditIssue)
'
rstAddEditIssue.MoveFirst ' Edit Issue modifiactions 'added 10-06-05
rstAddEditIssue.MoveLast ' Edit Issue modifiactions 'added 10-06-05
'
iReport = rstAddEditIssue!report_id
cboIssueNo.RowSource = sqlAddEditIssue
cboIssueNo = iReport
rstAddEditIssue.Close
ElseIf fraIssueInfo = 2 Then
'If the "Create New Issue" option, optEditIssue, is selected then it
verifies that the user wants to append the
'existing issue
iResponse = MsgBox("Are you sure you want to add the selected
instruments to the existing cover sheet?", vbYesNo + vbExclamation)
If iResponse = vbNo Then
DoCmd.Close acForm, "frmMessageCreate"
Exit Sub
End If
' Position the pointer at the begining of the data file
rstAddEditIssue.MoveLast ' Edit/ Issue modifiactions 'added
01-25-06
rstAddEditIssue.MoveFirst ' Edit/ Issue modifiactions 'added
01-25-06
'
sqlAddEditIssue = "UPDATE tblIssues SET project_id=" & iProjectID &
", spec_form_id=" & cboSpecForm.Column(0) & ", issue_no='" & txtIssueNumber
& "', issue_date=#" & txtIssueDate & "#, issue_description='" &
txtDescription & "', instr_engr='" & txtInstrEngr & "', package_no=" &
txtPackageNo & " WHERE report_id=" & cboIssueNo.Column(1)
dbCS.Execute sqlAddEditIssue
End If
'Opens the connection to the INtools SQL Server Database using ADO
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "driver={SQL Server};server=" & sServerName &
";UID=" & sProjectLogin & ";PWD=" & sPassword & ";database=" & sDatabaseName
cnn1.ConnectionTimeout = 60
cnn1.Open
'Cycles through the lstInstrIssue list and adds component and issue
information to the database for selected instruments
For iInstr = 0 To lstInstrIssue.ListCount - 1
If lstInstrIssue.Selected(iInstr) Then
'Checks the tblInstruments table, which contains component ID's of
ISSUED instruments only,
'for the selected tag number
sqlInstrTable = "SELECT * FROM tblInstruments WHERE project_id =
" & iProjectID & " AND cmpnt_id = " & lstInstrIssue.Column(0, iInstr)
Set rstInstrTable = dbCS.OpenRecordset(sqlInstrTable)
'Adds the component ID to the table the recordcount is 0, which
means it is not already in the table
If rstInstrTable.RecordCount = 0 Then
rstInstrTable.AddNew
rstInstrTable!project_id = iProjectID
rstInstrTable!cmpnt_id = lstInstrIssue.Column(0, iInstr)
rstInstrTable!spec_form_id = cboSpecForm.Column(0)
rstInstrTable.Update
Else
'If the component is already in the tblInstruments table, checks to
see if it has changed spec form numbers
'because many tags are reassigned to different spec forms. Sets a
boolean variable bSpecFormMatch to true
'if the spec form id still matches
bSpecFormMatch = False
'Test these 2 statement 1-23-2006
rstInstrTable.MoveLast ' Test these 2 statement
1-23-2006
rstInstrTable.MoveFirst 'Test these 2 statement 1-23-2006
Do Until rstInstrTable.EOF
If Val(rstInstrTable!spec_form_id) =
Val(cboSpecForm.Column(0)) Then
bSpecFormMatch = True
End If
rstInstrTable.MoveNext
Loop
'If the spec form does not match the existing record, a new record
is added for the tag number with the new spec form id
If bSpecFormMatch = False Then
rstInstrTable.AddNew
rstInstrTable!project_id = iProjectID
rstInstrTable!cmpnt_id = lstInstrIssue.Column(0, iInstr)
rstInstrTable!spec_form_id = cboSpecForm.Column(0)
rstInstrTable.Update
End If
End If
rstInstrTable.Close
'Opens the revision and spec_sheet_data tables in the SQL database
to retrieve the revision number and
'date based on the selected component ID
sqlRevInfo = "SELECT " & sProjectLogin & ".revision.rev_no, " &
sProjectLogin & ".revision.rev_date FROM " & sProjectLogin &
".spec_sheet_data, " & sProjectLogin & ".revision WHERE " & sProjectLogin &
".spec_sheet_data.dwg_id = " & sProjectLogin & ".revision.dwg_id AND " &
sProjectLogin & ".spec_sheet_data.cmpnt_id = " & lstInstrIssue.Column(0,
iInstr) & " AND " & sProjectLogin & ".revision.rev_id > 0 AND " &
sProjectLogin & ".revision.rev_date <= '" & cboIssueNo.Column(5) & "' ORDER
BY " & sProjectLogin & ".revision.rev_date"
Set rstRevInfo = New ADODB.Recordset
rstRevInfo.Open sqlRevInfo, cnn1, adOpenStatic, adLockReadOnly,
adCmdText
rstRevInfo.MoveFirst ' Added this line 1-25-06 Mo Madani
rstRevInfo.MoveLast
'Checks the tblIssuedSpecs table to see if the
component_id/report_id/rev_no exist in the table
sqlSpecs = "SELECT * FROM tblIssuedSpecs WHERE report_id = " &
cboIssueNo.Column(1) & " AND cmpnt_id = " & lstInstrIssue.Column(0, iInstr)
Set rstSpecs = dbCS.OpenRecordset(sqlSpecs)
'If it is not already in the table, adds the
component_id/report_id/rev_no as a new record
If rstSpecs.RecordCount = 0 Then
With rstSpecs
.AddNew
!report_id = cboIssueNo.Column(1)
!cmpnt_id = lstInstrIssue.Column(0, iInstr)
!rev_no = rstRevInfo!rev_no
.Update
End With
to SQL 2000, then everytime I try to append records or insert records ot a
table, I get this error.
ANy idea how ot get a permenant solution. All help appreciated (See Below)
sorry for the lengthy code:
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++
Private Sub cmdCreate_Click()
On Error GoTo Err_cmdCreate_Click
Dim cnn1 As ADODB.Connection
Dim rstRevInfo, rstTagNumbers As ADODB.Recordset
Dim dbCS As Database
Dim rstAddEditIssue, rstInstrTable, rstSpecs, rstInstruments, rstDelete
As Recordset
Dim sqlAddEditIssue, sqlInstrTable, sqlRevInfo, sqlSpecs, sqlInstruments,
sqlTagNumbers, sqlDelete, sqlInstrPrint As String
Dim iReport, iResponse, iInstr As Integer
Dim bInstrSelect, bSpecFormMatch As Boolean
'Cycles through the items in the lstInstrIssue list box and checks to see if
any instruments are selected
'If any are selected, sets a boolean flag, bInstrSelect, to true and exits
the For... Next loop
bInstrSelect = False
For iInstr = 0 To lstInstrIssue.ListCount - 1
If lstInstrIssue.Selected(iInstr) Then
bInstrSelect = True
Exit For
End If
Next iInstr
'If no issue is selected in the cboIssueNo control, a message box is shown
and the sub is exited
If IsNull(fraIssueInfo) Or (fraIssueInfo = 1 And (IsNull(txtIssueNumber)
Or IsNull(txtIssueDate) Or IsNull(txtDescription))) Or (fraIssueInfo = 2 And
IsNull(cboIssueNo.Column(0))) Then
Call MsgBox("Please complete Issue Information.", vbOKOnly +
vbExclamation)
Exit Sub
'If no instruments are selected in the lstInstrIssue control, as noted by
the bInstrSelect flag,
'a message box is shown and the sub is exited
ElseIf bInstrSelect = False Then
Call MsgBox("Please select at least one instrument.", vbOKOnly +
vbExclamation)
Exit Sub
'Generates the cover sheet if an issue number and instruments are selected
Else
DoCmd.OpenForm "frmMessageCreate" 'Flashes Message that alerts user
that report is generating
Set dbCS = CurrentDb
If fraIssueInfo = 1 Then
'If the "Create New Issue" option, optAddIssue, is selected then it
creates an record for the general cover sheet
'information in the tblIssues table
sqlAddEditIssue = "INSERT INTO tblIssues
(project_id,spec_form_id,rev_type,issue_no,issue_date," & _
"issue_description,instr_engr,package_no) VALUES (" & iProjectID
& "," & cboSpecForm.Column(0) & _
"," & fraIssueType & ",'" & txtIssueNumber & "',#" &
txtIssueDate & "#,'" & txtDescription & _
"','" & txtInstrEngr & "'," & txtPackageNo & ")"
dbCS.Execute sqlAddEditIssue
'Creates a recordset containing the record that was just added to the
issues table and sets that record as the
'rowsource for the Issue Number combo box. This is done to make the
following code identical for both creating
'and appending issues.
sqlAddEditIssue = "SELECT DISTINCT * FROM tblIssues WHERE
project_id=" & iProjectID & " AND spec_form_id=" & _
cboSpecForm.Column(0) & " AND rev_type=" & fraIssueType & " AND
issue_no='" & txtIssueNumber & "' AND issue_date=#" & _
txtIssueDate & "# AND issue_description='" & txtDescription & "'
AND instr_engr='" & txtInstrEngr & "' AND package_no=" & txtPackageNo
Set rstAddEditIssue = dbCS.OpenRecordset(sqlAddEditIssue)
'
rstAddEditIssue.MoveFirst ' Edit Issue modifiactions 'added 10-06-05
rstAddEditIssue.MoveLast ' Edit Issue modifiactions 'added 10-06-05
'
iReport = rstAddEditIssue!report_id
cboIssueNo.RowSource = sqlAddEditIssue
cboIssueNo = iReport
rstAddEditIssue.Close
ElseIf fraIssueInfo = 2 Then
'If the "Create New Issue" option, optEditIssue, is selected then it
verifies that the user wants to append the
'existing issue
iResponse = MsgBox("Are you sure you want to add the selected
instruments to the existing cover sheet?", vbYesNo + vbExclamation)
If iResponse = vbNo Then
DoCmd.Close acForm, "frmMessageCreate"
Exit Sub
End If
' Position the pointer at the begining of the data file
rstAddEditIssue.MoveLast ' Edit/ Issue modifiactions 'added
01-25-06
rstAddEditIssue.MoveFirst ' Edit/ Issue modifiactions 'added
01-25-06
'
sqlAddEditIssue = "UPDATE tblIssues SET project_id=" & iProjectID &
", spec_form_id=" & cboSpecForm.Column(0) & ", issue_no='" & txtIssueNumber
& "', issue_date=#" & txtIssueDate & "#, issue_description='" &
txtDescription & "', instr_engr='" & txtInstrEngr & "', package_no=" &
txtPackageNo & " WHERE report_id=" & cboIssueNo.Column(1)
dbCS.Execute sqlAddEditIssue
End If
'Opens the connection to the INtools SQL Server Database using ADO
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "driver={SQL Server};server=" & sServerName &
";UID=" & sProjectLogin & ";PWD=" & sPassword & ";database=" & sDatabaseName
cnn1.ConnectionTimeout = 60
cnn1.Open
'Cycles through the lstInstrIssue list and adds component and issue
information to the database for selected instruments
For iInstr = 0 To lstInstrIssue.ListCount - 1
If lstInstrIssue.Selected(iInstr) Then
'Checks the tblInstruments table, which contains component ID's of
ISSUED instruments only,
'for the selected tag number
sqlInstrTable = "SELECT * FROM tblInstruments WHERE project_id =
" & iProjectID & " AND cmpnt_id = " & lstInstrIssue.Column(0, iInstr)
Set rstInstrTable = dbCS.OpenRecordset(sqlInstrTable)
'Adds the component ID to the table the recordcount is 0, which
means it is not already in the table
If rstInstrTable.RecordCount = 0 Then
rstInstrTable.AddNew
rstInstrTable!project_id = iProjectID
rstInstrTable!cmpnt_id = lstInstrIssue.Column(0, iInstr)
rstInstrTable!spec_form_id = cboSpecForm.Column(0)
rstInstrTable.Update
Else
'If the component is already in the tblInstruments table, checks to
see if it has changed spec form numbers
'because many tags are reassigned to different spec forms. Sets a
boolean variable bSpecFormMatch to true
'if the spec form id still matches
bSpecFormMatch = False
'Test these 2 statement 1-23-2006
rstInstrTable.MoveLast ' Test these 2 statement
1-23-2006
rstInstrTable.MoveFirst 'Test these 2 statement 1-23-2006
Do Until rstInstrTable.EOF
If Val(rstInstrTable!spec_form_id) =
Val(cboSpecForm.Column(0)) Then
bSpecFormMatch = True
End If
rstInstrTable.MoveNext
Loop
'If the spec form does not match the existing record, a new record
is added for the tag number with the new spec form id
If bSpecFormMatch = False Then
rstInstrTable.AddNew
rstInstrTable!project_id = iProjectID
rstInstrTable!cmpnt_id = lstInstrIssue.Column(0, iInstr)
rstInstrTable!spec_form_id = cboSpecForm.Column(0)
rstInstrTable.Update
End If
End If
rstInstrTable.Close
'Opens the revision and spec_sheet_data tables in the SQL database
to retrieve the revision number and
'date based on the selected component ID
sqlRevInfo = "SELECT " & sProjectLogin & ".revision.rev_no, " &
sProjectLogin & ".revision.rev_date FROM " & sProjectLogin &
".spec_sheet_data, " & sProjectLogin & ".revision WHERE " & sProjectLogin &
".spec_sheet_data.dwg_id = " & sProjectLogin & ".revision.dwg_id AND " &
sProjectLogin & ".spec_sheet_data.cmpnt_id = " & lstInstrIssue.Column(0,
iInstr) & " AND " & sProjectLogin & ".revision.rev_id > 0 AND " &
sProjectLogin & ".revision.rev_date <= '" & cboIssueNo.Column(5) & "' ORDER
BY " & sProjectLogin & ".revision.rev_date"
Set rstRevInfo = New ADODB.Recordset
rstRevInfo.Open sqlRevInfo, cnn1, adOpenStatic, adLockReadOnly,
adCmdText
rstRevInfo.MoveFirst ' Added this line 1-25-06 Mo Madani
rstRevInfo.MoveLast
'Checks the tblIssuedSpecs table to see if the
component_id/report_id/rev_no exist in the table
sqlSpecs = "SELECT * FROM tblIssuedSpecs WHERE report_id = " &
cboIssueNo.Column(1) & " AND cmpnt_id = " & lstInstrIssue.Column(0, iInstr)
Set rstSpecs = dbCS.OpenRecordset(sqlSpecs)
'If it is not already in the table, adds the
component_id/report_id/rev_no as a new record
If rstSpecs.RecordCount = 0 Then
With rstSpecs
.AddNew
!report_id = cboIssueNo.Column(1)
!cmpnt_id = lstInstrIssue.Column(0, iInstr)
!rev_no = rstRevInfo!rev_no
.Update
End With