Code:
Option Compare Database
Option Explicit
Private Sub MegType_AfterUpdate()
On Error GoTo EH
'Sets field values based on MegType selection
Me.MegID = Me.MegType.Column(0)
Me.MegSC = Me.MegType.Column(2)
Me.MegDue = Me.MegType.Column(3)
'Ends code
Exit Sub
'If error occurs
EH:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
Private Sub PISC_AfterUpdate()
On Error GoTo EH
'Sets field values based on PISC selection
Me.PIID = Me.PISC.Column(0)
Me.PIDue = Me.PISC.Column(3)
'Ends code
Exit Sub
'If error occurs
EH:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
Private Function ConvertUnits(InVal As Double, InUnit As String) As Double
Select Case InUnit
Case "G"
ConvertUnits = (InVal * 1000000000)
Case "M"
ConvertUnits = (InVal * 1000000)
Case Else
ConvertUnits = InVal
End Select
End Function
Private Sub btnSubmit_Click()
'On Error GoTo EH
'Checks for data in Tank
If IsNull(Me.Tank.Value) = True Then
MsgBox "Please enter a tank.", vbOKOnly, "Error"
Me.Tank.SetFocus
Exit Sub
End If
'Checks for data in Load
If IsNull(Me.Load.Value) = True Then
MsgBox "Please enter a load.", vbOKOnly, "Error"
Me.Load.SetFocus
Exit Sub
End If
'Checks for data in Date
If IsNull(Me.TestedDate.Value) = True Then
MsgBox "Please enter a date.", vbOKOnly, "Error"
Me.TestedDate.SetFocus
Exit Sub
End If
'Checks for data in MegType
If IsNull(Me.MegType.Value) = True Then
MsgBox "Please enter a megger type.", vbOKOnly, "Error"
Me.MegType.SetFocus
Exit Sub
End If
'Checks for data in PISC
If IsNull(Me.PISC.Value) = True Then
MsgBox "Please enter a pressure indicator S&C.", vbOKOnly, "Error"
Me.PISC.SetFocus
Exit Sub
End If
'Checks for data in Tech
If IsNull(Me.Tech.Value) = True Then
MsgBox "Please enter a test technician.", vbOKOnly, "Error"
Me.Tech.SetFocus
Exit Sub
End If
'Creates variables
Dim add1 As String
Dim add2 As String
Dim add3 As String
Dim add4 As String
Dim add5 As String
Dim add6 As String
Dim add7 As String
Dim add8 As String
Dim add9 As String
Dim addTank As Integer
Dim addLoad As Integer
Dim addDate As Date
Dim addMeg As Integer
Dim addPI As Integer
Dim addTech As String
Dim dbTest As DAO.Database
Dim rstTestData As DAO.Recordset
Dim ctlVar As Control
Dim i As Integer
'Defines variables
addTank = Me.Tank
addLoad = Me.Load
addDate = Me.TestedDate
addMeg = Me.MegID
addPI = Me.PIID
addTech = Me.Tech
'Sets table "tbl_343sTested" as recordset
Set dbTest = CurrentDb
Set rstTestData = dbTest.OpenRecordset("tbl_343sTested")
'----------------------------------------------------------------------------------------
' Start of writing the recordset
' Checks each position for a serial number then processes the data for each record
'----------------------------------------------------------------------------------------
'Adds data if data in SN1
'checks for each of 9 records
'Ends code if no data in SN1
If IsNull(Me.SN1.Value) = True Then
GoTo Continue
Else
add1 = UCase(Me.SN1)
rstTestData.AddNew
rstTestData("FixturePosition") = 1
rstTestData("SerialNumber") = add1
Debug.Print CDbl(txtPre1)
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre1), Me.cboPreUnit1)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh1), Me.cboHighUnit1)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost1), Me.cboPreUnit1)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN2
If IsNull(Me.SN2.Value) = True Then
GoTo Continue
'Adds data if data in SN2
Else
add2 = UCase(Me.SN2)
rstTestData.AddNew
rstTestData("FixturePosition") = 2
rstTestData("SerialNumber") = add2
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre2), Me.cboPreUnit2)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh2), Me.cboHighUnit2)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost2), Me.cboPreUnit2)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN3
If IsNull(Me.SN3.Value) = True Then
GoTo Continue
'Adds data if data in SN3
Else
add3 = UCase(Me.SN3)
rstTestData.AddNew
rstTestData("FixturePosition") = 3
rstTestData("SerialNumber") = add3
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre3), Me.cboPreUnit3)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh3), Me.cboHighUnit3)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost3), Me.cboPreUnit3)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN4
If IsNull(Me.SN4.Value) = True Then
GoTo Continue
'Adds data if data in SN4
Else
add4 = UCase(Me.SN4)
rstTestData.AddNew
rstTestData("FixturePosition") = 4
rstTestData("SerialNumber") = add4
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre4), Me.cboPreUnit4)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh4), Me.cboHighUnit4)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost4), Me.cboPreUnit4)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN5
If IsNull(Me.SN5.Value) = True Then
GoTo Continue
'Adds data if data in SN5
Else
add5 = UCase(Me.SN5)
rstTestData.AddNew
rstTestData("FixturePosition") = 5
rstTestData("SerialNumber") = add5
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre5), Me.cboPreUnit5)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh5), Me.cboHighUnit5)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost5), Me.cboPreUnit5)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN6
If IsNull(Me.SN6.Value) = True Then
GoTo Continue
'Adds data if data in SN6
Else
add6 = UCase(Me.SN6)
rstTestData.AddNew
rstTestData("FixturePosition") = 6
rstTestData("SerialNumber") = add6
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre6), Me.cboPreUnit6)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh6), Me.cboHighUnit6)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost6), Me.cboPreUnit6)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN7
If IsNull(Me.SN7.Value) = True Then
GoTo Continue
'Adds data if data in SN7
Else
add7 = UCase(Me.SN7)
rstTestData.AddNew
rstTestData("FixturePosition") = 7
rstTestData("SerialNumber") = add7
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre7), Me.cboPreUnit7)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh7), Me.cboHighUnit7)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost7), Me.cboPreUnit7)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN8
If IsNull(Me.SN8.Value) = True Then
GoTo Continue
'Adds data if data in SN8
Else
add8 = UCase(Me.SN8)
rstTestData.AddNew
rstTestData("FixturePosition") = 8
rstTestData("SerialNumber") = add8
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre8), Me.cboPreUnit8)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh8), Me.cboHighUnit8)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost8), Me.cboPreUnit8)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
'Ends code if no data in SN9
If IsNull(Me.SN9.Value) = True Then
GoTo Continue
'Adds data if data in SN9
Else
add9 = UCase(Me.SN9)
rstTestData.AddNew
rstTestData("FixturePosition") = 9
rstTestData("SerialNumber") = add9
rstTestData("PreReading") = ConvertUnits(CDbl(txtPre9), Me.cboPreUnit9)
rstTestData("HighReading") = ConvertUnits(CDbl(txtHigh9), Me.cboHighUnit9)
rstTestData("PostReading") = ConvertUnits(CDbl(txtPost9), Me.cboPreUnit9)
rstTestData("TestedDate") = addDate
rstTestData("Technician") = addTech
rstTestData("TankTestedIn") = addTank
rstTestData("LoadTested") = addLoad
rstTestData("MeggerID") = addMeg
rstTestData("PressureIndID") = addPI
rstTestData.Update
End If
Continue:
'Notifies of successful data entry
MsgBox "Data has successfully been entered.", vbOKOnly, "Success"
'----------------------------------------------------------------------------------------
' Sets print to automatic or Preview(for developement)
'----------------------------------------------------------------------------------------
'DoCmd.OpenReport "rpt_343DataSheet", acViewNormal
'DoCmd.Close acReport, "rpt_343DataSheet"
DoCmd.OpenReport "rpt_343DataSheet", acViewReport
Print_Continue:
'Ends code
Exit Sub
'If error occurs
EH:
If Err.Number = 2501 Then
GoTo Print_Continue
Else
MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub