Connect To A Database & Pull Data (To VBA Form)

This code connects to a database and fills in a VBA Form with the values. It has a case id passed to it from a form before this one and it picks up this data from a tab in excel

'Runs At Form Initilisation. txtCaseIDNo = Range("Data_Passer!B1").Value Sheets("Abs").Select ' connect to the database Dim cn As ADODB.Connection, rs As ADODB.Recordset Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=\\C900000FSL0001\Hxd$\HCA\10. MPT Scotland\Shared\Abs\Data\A_DB.mdb;" & _ "Jet OLEDB:Database Password=thrufelt;" 'Open Returned Complaint Table Set rs = New ADODB.Recordset rs.Open "qryShortTerm_Abs_Edit", cn, adOpenKeyset, adLockOptimistic, adCmdTable 'With rs       rs.Find "[Case ID] = #" & txtCaseIDNo & "#" If (rs.EOF) Then MsgBox "This Short Term Absence Case Has Not Been Found. Please check the Case ID & Try Again", vbInformation, "Abs" Range("Data_Passer!A1").Value = "" Range("Data_Passer!B1").Value = "" Unload Me           Else 'Filter the data to only include the case id required rs.Filter = "[Case ID] = #" & txtCaseIDNo & "#" 'Check that this user has edit permission for this case If Range("Abs!L3").Value = "1" Then 'This user has full access ... Continue 'Populate The Boxes txtPnum.Text = rs![Personnel Number] txtName.Text = rs![AGENT_NAME] txtTM.Text = rs![TM] cbReason = rs![Absence Reason] dtFirstDate = rs![First Date of Absence] txtNoDays = rs![No of Days Current Absence] dtExpected = rs![Expected RTW Date] dtActual = rs![Actual RTW Date] txtNoIn12 = rs![No Of Occurances in last 12 Months] cbAMR = rs![Welfare Stage/Moving To Stage] dtReviewDate = rs![Date of Next Review] txtComments = rs![Comments] cbStatus = rs![status] 'closing current table rs.Close Set rs = Nothing 'closing DB connection cn.Close Set cn = Nothing 'End With 'Clear the cells on Data tab. Sheets("Abs").Select Application.ScreenUpdating = True ElseIf Range("Abs!L3").Value = rs![AL] Then 'This user has this level of access ... Continue 'Populate The Boxes txtPnum.Text = rs![Personnel Number] txtName.Text = rs![AGENT_NAME] txtTM.Text = rs![TM] cbReason = rs![Absence Reason] dtFirstDate = rs![First Date of Absence] txtNoDays = rs![No of Days Current Absence] dtExpected = rs![Expected RTW Date] dtActual = rs![Actual RTW Date] txtNoIn12 = rs![No Of Occurances in last 12 Months] cbAMR = rs![Welfare Stage/Moving To Stage] dtReviewDate = rs![Date of Next Review] txtComments = rs![Comments] cbStatus = rs![status] 'closing current table rs.Close Set rs = Nothing 'closing DB connection cn.Close Set cn = Nothing 'End With 'Clear the cells on Data tab. Sheets("Abs").Select Application.ScreenUpdating = True Else 'This user does not have access to this case - STOP THEM! MsgBox "This Case Has Been Found However You Do Not Have Access To Update This Case", vbCritical, "Abs" Range("Data_Passer!A1").Value = "" Range("Data_Passer!B1").Value = "" Unload Me               End If            End If

Code Snippits