hi all,
I have completed migration of my Access DB to SQL server with Access as my Front End
(Department decision). Now i am having an issue with a Calculated field in a key table. I know Calculated fields do not work in SQL and have been trying to find a way to work around this.
The Access database has contacts and based on the type of Contact, a calculated field "Corder" is assigned a number. The Calculation in the Access Database right now is:
Now i know i need to probably make th change to the Refresh CODE but i am having trouble with my
SELECT CASE WHEN ... THEN .. Statement ...
I have completed migration of my Access DB to SQL server with Access as my Front End
(Department decision). Now i am having an issue with a Calculated field in a key table. I know Calculated fields do not work in SQL and have been trying to find a way to work around this.The Access database has contacts and based on the type of Contact, a calculated field "Corder" is assigned a number. The Calculation in the Access Database right now is:
Code:
(IIf([Role]="Principal Investigator","1",
(IIf([Role]="Sub-Investigator","2",
(IIf([Role]="Study Coordinator","3",
(IIf([Role]="Co-Study Coordinator","4",
(IIf([Role]="Blinded Assessor","5",
(IIf([Role]="CT Tech","6",
(IIf([Role]="Lab Tech","7",
(IIf([Role]="Laboratory Director","8",
(IIf([Role]="Other","9",""))))))))))))))))))
[CODE]
The subform that records these Contacts looks like the image (Conacts List Box)
Based on the Role of the person, the RefreshFunction sorts the list box after the entry is Saved.
[CODE]
Option Compare Database
'Adding new Contact
Private Sub AddCont_Click()
Me.author.Value = ""
Me.AuthorRole.Value = ""
Me.RoleOth.Value = ""
Me.Condition.Value = ""
Me.othrcondition.Value = ""
Me.CmbTest.Value = ""
Me.email.Value = ""
Me.phone.Value = ""
Me.ophone.Value = ""
Me.cphone.Value = ""
Me.fax.Value = ""
Me.fix.Value = ""
Me.stats.Value = ""
Me.txtAction.Value = "NewRecord"
End Sub
'The SAVE Command button
Private Sub Command5_Click()
Dim db As Database
Set db = CurrentDb
Dim rs As DAO.Recordset
Dim Sqlstr As String
Dim SQLStr2 As String
On Error GoTo HandleError
If Me.txtAction.Value = "NewRecord" Then
Set rs = CurrentDb.OpenRecordset("Contacts", dbDynaset, [dbSeeChanges])
With rs
.AddNew
![SiteID] = Me.Parent!NewSiteID.Value
![Name] = Me.author.Value
![Role] = Me.AuthorRole.Value
![ORole] = Me.RoleOth.Value
' ![Corder] = Me.txtorder.Value
![Speciality] = Me.Condition.Value
![SpecialityOther] = Me.othrcondition.Value
![Test] = Me.CmbTest.Value
![email] = Me.email.Value
![phone] = Me.phone.Value
![OfficePhone] = Me.ophone.Value
![cellphone] = Me.cphone.Value
![fax] = Me.fax.Value
![Suffix] = Me.fix.Value
![Status] = Me.stats.Value
.Update
End With
rs.Close
Set rs = Nothing
MsgBox ("Record is saved")
Me.txtAction.Value = ""
'refresh list box
Call RefreshLstAuthors
ElseIf Me.txtAction.Value = "UpdateRecord" Then
Sqlstr = "UPDATE Contacts SET Name = " & "'" & Me.author.Value & "'" & ", Role = " & "'" & Me.AuthorRole.Value & "'" & _
", ORole = " & "'" & Me.RoleOth.Value & "'" & ", Speciality = " & "'" & Me.Condition.Value & "'" & _
", SpecialityOther = " & "'" & Me.othrcondition.Value & "'" & ", Test = " & "'" & Me.CmbTest.Value & "'" & _
", Email = " & "'" & Me.email.Value & "'" & ", Phone = " & "'" & Me.phone.Value & "'" & ", officephone = " & "'" & Me.ophone.Value & "'" & _
", cellphone = " & "'" & Me.cphone.Value & "'" & ", Fax = " & "'" & Me.fax.Value & "'" & _
", Suffix = " & "'" & Me.fix.Value & "'" & ", Status = " & "'" & Me.stats.Value & "'" & _
" WHERE ContactID = " & Me.LstAuthors.Value & " AND SiteID = " & Me.Parent!NewSiteID.Value
db.Execute Sqlstr, [dbSeeChanges]
'refresh list box
Call RefreshLstAuthors
MsgBox ("Record is updated")
Else
End If
db.Close
' Me.LstAuthors.Requery
ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere
End Sub
'Subform on Load
Private Sub Form_Load()
Me.author.Value = ""
Me.AuthorRole.Value = ""
Me.RoleOth.Value = ""
Me.Condition.Value = ""
Me.othrcondition.Value = ""
Me.CmbTest.Value = ""
Me.email.Value = ""
Me.phone.Value = ""
Me.ophone.Value = ""
Me.cphone.Value = ""
Me.fax.Value = ""
Me.fix.Value = ""
Me.stats.Value = ""
Me.txtAction.Value = ""
End Sub
'SubForm on Open
Private Sub Form_Open(Cancel As Integer)
Me.author.Value = ""
Me.AuthorRole.Value = ""
Me.RoleOth.Value = ""
Me.Condition.Value = ""
Me.othrcondition.Value = ""
Me.CmbTest.Value = ""
Me.email.Value = ""
Me.phone.Value = ""
Me.ophone.Value = ""
Me.cphone.Value = ""
Me.fax.Value = ""
Me.fix.Value = ""
Me.stats.Value = ""
Me.txtAction.Value = ""
Dim db As DAO.Database
Set db = CurrentDb
Dim rcount As DAO.Recordset
Dim rs As DAO.Recordset
Dim SQLCount As String
Dim Sqlstr As String
Dim Records As String
Dim Count As Integer
Dim i As Integer
Dim rsDate As String
Dim rsAuthor As String
Dim rsNote As String
Dim strReturn As String
SQLCount = "SELECT Count(*) FROM Contacts WHERE Contacts.SiteID = " & Me.Parent!NewSiteID.Value
Set rcount = db.OpenRecordset(SQLCount, dbOpenDynaset, [dbSeeChanges])
rcount.MoveFirst
Count = rcount.Fields(0).Value
rcount.Close
Set rcount = Nothing
' recordset
Sqlstr = "SELECT Contacts.ContactID, Contacts.Name, Contacts.Role, Contacts.ORole, Contacts.Corder" & _
", Contacts.Speciality, Contacts.SpecialityOther ,Contacts.Email, Contacts.Phone" & _
", Contacts.officephone,Contacts.cellphone,Contacts.Fax, Contacts.Test " & _
", Contacts.Status, Contacts.Suffix " & _
" FROM Contacts WHERE Contacts.SiteID = " & Me.Parent!NewSiteID.Value & " ORDER BY Contacts.Corder"
Set rs = db.OpenRecordset(Sqlstr, dbOpenDynaset, [dbSeeChanges])
Me.LstAuthors.RowSourceType = "Value List"
If Count = 0 Then
Me.LstAuthors.RowSource = ""
Else
rs.MoveFirst
Do Until rs.EOF
For i = 0 To Count - 1
With Me.LstAuthors
.RowSourceType = "Value List"
.ColumnCount = 6
.AddItem Item:=rs![ContactID] & ";" & rs![Corder] & ";" & rs![Name] & ";" & rs![Role] & ";" & rs![ORole] & ";" & rs![Status], Index:=i
End With
rs.MoveNext
Next i
Loop
End If
rs.Close
Set rs = Nothing
db.Close
End Sub
'Refresh function
Private Sub RefreshLstAuthors()
Dim db As DAO.Database
Dim rcount As DAO.Recordset
Dim rs As DAO.Recordset
Dim Sqlstr As String
Dim SQLCount As String
Dim Records As String
Dim Count As Integer
Dim i As Integer
Me.author.Value = ""
Me.AuthorRole.Value = ""
Me.RoleOth.Value = ""
Me.Condition.Value = ""
Me.othrcondition.Value = ""
Me.CmbTest.Value = ""
Me.email.Value = ""
Me.phone.Value = ""
Me.ophone.Value = ""
Me.cphone.Value = ""
Me.fax.Value = ""
Me.fix.Value = ""
Me.stats.Value = ""
Me.txtAction.Value = ""
Me.LstAuthors.RowSource = ""
'
SQLCount = "SELECT Count(*) FROM Contacts WHERE Contacts.SiteID = " & Me.Parent!NewSiteID.Value
Set db = CurrentDb
Set rcount = db.OpenRecordset(SQLCount, dbOpenDynaset, [dbSeeChanges])
rcount.MoveFirst
Count = rcount.Fields(0).Value
rcount.Close
Set rcount = Nothing
Sqlstr = "SELECT Contacts.ContactID, Contacts.Name, Contacts.Role, Contacts.ORole, Contacts.Corder" & _
", Contacts.Speciality, Contacts.SpecialityOther ,Contacts.Email, Contacts.Phone" & _
", Contacts.officephone, Contacts.cellphone, Contacts.Fax, Contacts.Test " & _
", Contacts.Status, Contacts.Suffix " & _
"FROM Contacts WHERE SiteID = " & Me.Parent!NewSiteID.Value & " ORDER BY Contacts.Corder"
Set rs = db.OpenRecordset(Sqlstr, dbOpenDynaset, [dbSeeChanges])
Me.LstAuthors.RowSourceType = "Value List"
If Count < 0 Then
' Me.LstAuthors.RowSource = ""
Else
rs.MoveFirst
Do Until rs.EOF
For i = 0 To Count - 1
With Me.LstAuthors
.RowSourceType = "Value List"
.ColumnCount = 6
.AddItem Item:=rs![ContactID] & ";" & rs![Corder] & ";" & rs![Name] & ";" & rs![Role] & ";" & rs![ORole] & ";" & rs![Status], Index:=i
End With
rs.MoveNext
Next i
Loop
End If
rs.Close
Set rs = Nothing
db.Close
End Sub
Private Sub LstAuthors_Click()
Dim Sqlstr As String
Dim db2 As Database
Dim rst As DAO.Recordset
Set db2 = CurrentDb
If IsNull(Me.LstAuthors.Value) = False Then
Sqlstr = "SELECT Name, Role, ORole ,Speciality, SpecialityOther, Test, Email, Phone, officephone, cellphone, Fax, Suffix, Status FROM Contacts WHERE ContactID = " & Me.LstAuthors.Value & " ORDER BY Contacts.Corder"
Set rst = db2.OpenRecordset(Sqlstr, dbOpenDynaset, [dbSeeChanges])
'
rst.MoveFirst
Me.author.Value = rst.Fields(0).Value
Me.AuthorRole.Value = rst.Fields(1).Value
Me.RoleOth.Value = rst.Fields(2).Value
Me.Condition.Value = rst.Fields(3).Value
Me.othrcondition.Value = rst.Fields(4).Value
Me.CmbTest.Value = rst.Fields(5).Value
Me.email.Value = rst.Fields(6).Value
Me.phone.Value = rst.Fields(7).Value
Me.ophone.Value = rst.Fields(8).Value
Me.cphone.Value = rst.Fields(9).Value
Me.fax.Value = rst.Fields(10).Value
Me.fix.Value = rst.Fields(11).Value
Me.stats.Value = rst.Fields(12).Value
rst.Close
db2.Close
Me.txtAction.Value = "UpdateRecord"
Else
End If
End SubNow i know i need to probably make th change to the Refresh CODE but i am having trouble with my
SELECT CASE WHEN ... THEN .. Statement ...
Code:
SELECT CASE WHEN [Role]="Principal Investigator" THEN Corder="1"
...
...
..
ELSE
END
[CODE]
It show me an syntax error in the
"SELECT CASE ..." part of the statement. Also can i create a SQL query performing this action as a function and Call it like the Refresh function?
Please helpAttachments
-
contacts list box.png
