accessNator
Registered User.
- Local time
- Yesterday, 22:34
- Joined
- Oct 17, 2008
- Messages
- 132
Here is a code that I wrote and I was wondering if anyone can shed some advice if there is a better way of doing this. I am open for suggestions. Please provide helpful advice. Thanks. The code works but I am wondering if I can make it better.
Code:
Private Sub cmdSaveRecord_Click()
'=========== Prompt USER TO ACCEPT RECORD ================
' Confirm to continue
If MsgBox("Do you wish to Accept The Record?", vbYesNo, "Accept Record") = vbNo Then
Exit Sub
End If
On Error GoTo Err_cmdSaveRecord_Click
'Initialize ctl as all Controls in Form
Dim ctl As Control
'============ Check Each Control in Form ============
For Each ctl In Me.Controls
Select Case (ctl.ControlType)
Case Is = acOptionGroup
If (Me.txtInputOriginalWid = 0 And Me.FrameRevenueOptions.Value = -1) Then
' Prompt Warning
MsgBox "An option for Revision has been Selected. A Original Worksheet Id is needed.", vbInformation, "Validation Check"
' Set Focus
Me.txtInputOriginalWid.SetFocus
' Cancel operation
Cancel = True
Exit Sub
ElseIf (Me.txtInputOriginalWid > 0 And (Me.FrameRevenueOptions.Value = 0)) Then
' Prompt Warning
MsgBox "A Original Worksheet Id is not valid. Resetting to 0.", vbInformation, "Validation Check"
' Set Focus
Me.txtInputOriginalWid.Value = 0
' Set Enabled Property For History Button
Me.cmdOpenHistory.Enabled = False
Me.txtInputOriginalWid.Enabled = False
' Cancel operation
Cancel = True
Exit Sub
End If
End Select
Next ctl
'======================== Check if Worksheet has been submitted For a given Period, or
'======================== Check if A Revision sheet is trying to be submitted before a Original Worksheet Submission For A given Period
Dim db As DAO.Database
Set db = CurrentDb
'Dim Table1 As String
Table1 = "tblFundData"
Dim Query0 As String
Query0 = "qryDetail"
On Error Resume Next
' Delete Querie(s) If exist
DoCmd.DeleteObject acQuery, Query0
On Error GoTo 0
Dim qdf0 As DAO.QueryDef
Dim rst0 As DAO.Recordset
Dim strSQL0 As String
Dim passRevision As Boolean
Dim passTrueUp As Boolean
Dim periodStart As Date
Dim periodEnd As Date
Dim periodLength As Integer
periodStart = Me.txtStartPeriod
periodEnd = Me.txtEndPeriod
periodLength = Me.txtPeriodLength
passRevision = False
passTrueUp = False
' Create Sql String From Table1
strSQL0 = "SELECT ref_id, cid, period_start, period_end, revision, true_up "
strSQL0 = strSQL0 & "FROM " & Table1 & " "
strSQL0 = strSQL0 & "WHERE cid = " & Me!txtInputCompanyId.Value & " and "
strSQL0 = strSQL0 & "period_start = #" & periodStart & "# And period_end = #" & periodEnd & "# And "
strSQL0 = strSQL0 & "revision = " & passRevision & " And true_up = " & passTrueUp & ";"
' Initialize Query
Set qdf0 = db.CreateQueryDef(Query0, strSQL0)
Set rst0 = qdf0.OpenRecordset(dbOpenDynaset)
If ((Not rst0.BOF) And (Not rst0.EOF)) Then
rst0.MoveLast
End If
' Important if you want to get an accurate Record Count
Select Case Me.FrameRevenueOptions.Value
Case Is = 0
If rst0.RecordCount >= 1 Then
Response = MsgBox("An Original Worksheet has already been submitted for this period!", vbOKOnly, "Validation Check")
'cancel
Exit Sub
End If
Case Is = -1
If rst0.RecordCount <> 1 Then
Response = MsgBox("A Revision Worksheet cannot be entered. An Original Worksheet has not been submitted for this period!", vbOKOnly, "Validation Check")
'cancel
Exit Sub
End If
End Select
rst0.Close
Set rst0 = Nothing
'======================== Execute PASS THROUGH QUERY TO REMOTE DATABASE TO UPDATE WORKSHEET
Dim qd As DAO.QueryDef
Dim QueryName As String
Dim passSpName As String
Dim passDateTime As String
QueryName = ""
passSpName = "usp_UpdateTransactions"
passDateTime = Now()
Set db = CurrentDb 'Current Database
Set qd = db.CreateQueryDef(QueryName)
passConnServer = ConnServer ' Calling From Module_Server For Server Connection
'Set Stored Procedure Attributes
With qd
.Connect = SetConnectionString(passConnServer)
.SQL = "Exec " & passSpName & " " & Me.txtTKW_RefId & ", 2, '" & passDateTime & "'"
.ReturnsRecords = False
.Execute
.Close
End With
Set qd = Nothing
'======================== RETREIVE HIGHEST NUMBER IN WID COLUMN and INCREMENT by 1 TO BE USED TO INSERTING A RECORD
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim qdf1 As DAO.QueryDef
Dim Query1 As String
Query1 = "qryMaxOfWIDFundData"
On Error Resume Next
' Delete Querie(s) If exist
DoCmd.DeleteObject acQuery, Query1
On Error GoTo 0
Dim strSQL As String
Dim newWID As Double
strSQL = "SELECT Max([wid]) AS maxWid FROM tblFundData;"
' Initialize Query
Set qdf1 = db.CreateQueryDef(Query1, strSQL)
Set rst1 = qdf1.OpenRecordset(dbOpenDynaset)
If Not rst1.EOF Then
newWID = rst1![maxWid] + 1
End If
'======================== INSERT RECORD IN LOCAL TABLE OF LOCAL DATABASE
Set rst2 = db.OpenRecordset("tblFundData")
With rst2
.AddNew
rst2![wid] = newWID
rst2![cid] = Me!txtInputCompanyId.Value
rst2![submission_date] = Me!txtInputSubmissionDate
rst2![report_basic_id] = Me!cboReportingBasic.Value
rst2![report_month] = Me!txtReportingMonth.Value
rst2![period_start] = periodStart
rst2![period_end] = periodEnd
rst2![period_length] = periodLength
'Check if One Time selection is made
If (Me.FrameRevenueOptions.Value = 2) Then
rst2![revision] = 0
rst2![true_up] = 0
Else
rst2![revision] = Me.FrameRevenueOptions.Value
rst2![true_up] = 0
End If
rst2![original_wid] = Me!txtInputOriginalWid
rst2![local_exch_serv] = Me!txtInputLocalExchange
rst2![late_charge] = Me!txtInputLateFee
rst2![signature_date] = Me!txtInputCertificationDate
rst2![signature_name] = UCase(Me!txtInputCertifiedByName)
.Update
End With
rst1.Close
rst2.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set db = Nothing
'======================== REQUERY FORM
Forms![frmOnlineSubmission]!sfrmContainerOnlineSubmissionData.Requery
MsgBox ("Record Entered!")
'======================== SEND EMAIL OUT
SendEmailOut "Approved", "", ""
DoCmd.Close
Exit_cmdSaveRecord_Click:
Exit Sub
Err_cmdSaveRecord_Click:
MsgBox Err.Description
Resume Exit_cmdSaveRecord_Click
End Sub
