Background: I have a multiple user database that lives on a trusted network drive with the file extension set to .accdr
The form I am having problems with has multiple pages on the tab control and most of the pages have 1 or 2 sub-forms on the page. This is the form where the users make all of their updates to their data.
The Issue: Just recently when users update a check box on one of the sub-forms they are receiving this error:
The expression After Update you entered as the event property setting produced the following error: Object of class does not support the set of events.
The After Update is set to this code:
This worked fine until just recently and I do not get the same message when I update the field in the database with a .accdb file extension. During the last roll-out we added some check boxes that are read only (Locked =Yes and Enabled =No). These check boxes do not have the After Update code as we are not updating them here. We also added some text boxes that are read only. The other change to the database is that we added code to detect the idle time, provide the user with a warning, and shut down the database. If this form is open when the database goes to shut down the user is getting Error Number 3071 - This expression is typed incorrectly, or is too complex to be evaluated. I don't know if the two errors are related. I mentioned it here in case they are. The confusing part of this 3071 error is that it is referencing the Form Load Sub on the error message. Why would the Form Load, which I am not having problems with, affect the shutting down of the database? In case it is the Form Loading Code that is the cause of the issue I have included it here. The purpose of this code is to load 3 indicators. Also, this error occurs when the database is .accdb or .accdr.
Is there anything I can add to my Error message that will help me track this down when the database is set as .accdr? Do you know what is causing this? Where should I start looking?
The form I am having problems with has multiple pages on the tab control and most of the pages have 1 or 2 sub-forms on the page. This is the form where the users make all of their updates to their data.
The Issue: Just recently when users update a check box on one of the sub-forms they are receiving this error:
The expression After Update you entered as the event property setting produced the following error: Object of class does not support the set of events.
The After Update is set to this code:
Code:
Private Sub EnviroNote_AfterUpdate()
On Error GoTo Err_EnviroNote_AfterUpdate
DoCmd.RunCommand acCmdSaveRecord
Exit_EnviroNote_AfterUpdate:
Exit Sub
Err_EnviroNote_AfterUpdate:
MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description, vbCritical + vbOKOnly, _
"Error After Update Enviromental Note"
Resume Exit_EnviroNote_AfterUpdate
End Sub
Code:
Private Sub Form_Load()
'Hide the Project Indicators if the Users has selected any month in the past
On Error GoTo Err_Form_Load
Dim iMonth As Integer 'Month on the PM Information Management Project Selection Tool
Dim iYear As Integer 'Year on the PM Information Management Project Selection Tool
Dim iCMnth As Integer 'Calendar Current Month
Dim iCYr As Integer 'Calendar Current Year
Dim Conn As ADODB.Connection
Dim stPath As String
Dim rst As ADODB.Recordset
Dim sSQL As String
Dim rst2 As ADODB.Recordset
Dim sSQL2 As String
Dim sSQL2Select As String
Dim sSQL2From As String
Dim sSQL2Where As String
Dim sSQL2group As String
Dim rst3 As ADODB.Recordset
Dim sSQL3 As String
Dim dblPlanEst As Double
Dim dblDesignEst As Double
Dim dblROWEst As Double
Dim dblConEst As Double
Dim dblPlanApprv As Double
Dim dblDesignApprv As Double
Dim dblROWApprv As Double
Dim dblConApprv As Double
Dim dblPlanLTD As Double
Dim dblDesignLTD As Double
Dim dblROWLTD As Double
Dim dblConLTD As Double
Dim stCostVarCat As String
Dim strCM As String
Dim dteMilestoneDS As Variant
Dim dteMilestone30 As Variant
Dim dteMilestone60 As Variant
Dim dteMilestone90 As Variant
Dim dteMilestone100 As Variant
Dim dteMilestoneAd As Variant
Dim dteMilestoneNTP As Variant
Dim dteMilestoneSC As Variant
Dim dteMilestonePC As Variant
Dim dteMilestoneCC As Variant
Dim dteBaseDS As Variant
Dim dteBase30 As Variant
Dim dteBase60 As Variant
Dim dteBase90 As Variant
Dim dteBase100 As Variant
Dim dteBaseAd As Variant
Dim dteBaseNTP As Variant
Dim dteBaseSC As Variant
Dim dteBasePC As Variant
Dim dteBaseCC As Variant
Dim stSchedVarCat As String
'Secured Funding Indicator
Dim dblSecFundAmt As Double
Dim dblAPCEAmt As Double
Dim dblLTDExp As Double
Dim dblCAC As Double
Dim dblSECDFUNDAMT As Double
Dim stSecdFundVarCat As String
Dim blnFndPnd As Boolean
'10/23/14
Static intCallCount As Long
iMonth = Forms!frmPMInfoMgmtTool_ProjSelect!cmb_ExpMnth
iYear = Forms!frmPMInfoMgmtTool_ProjSelect!cmb_ExpYr
iCMnth = month(Date)
iCYr = Year(Date)
If intCallCount = 0 Then
Me.RecordSource = "qfrmPMInfoMgmtTool"
' Set the string to the path of your database
stPath = CurrentDb.Name
' Debug.Print stPath
' Open connection to the database
Set Conn = New ADODB.Connection
Conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & stPath & ";"
Conn.Open
'Cost Indicator__________________________
'Open recordset
Set rst = New ADODB.Recordset
'Pull the Cost at Complete values
sSQL = "SELECT zzCost.CACYR, zzCost.CACMNTH, zzCost.SUBPROJECTID, TBLSUBPROJECTINFORMATION.CONSTRCOSTNOTRQD, TBLSUBPROJECTINFORMATION.DESIGNCOSTNOTRQD, zzCost.PROJECTID, zzCost.PlanEst, zzCost.PlanApprv, zzCost.PlanLTD, zzCost.DesignEst" _
& ", zzCost.DesignApprv, zzCost.DesignLTD, zzCost.ROWEst, zzCost.ROWApprv, zzCost.ROWLTD, zzCost.ConEst, zzCost.ConApprv, zzCost.ConLTD" _
& " FROM (SELECT TBLPRJTCOSTATCOMPLETE.CACMNTH,TBLPRJTCOSTATCOMPLETE.CACYR, TBLPRJTCOSTATCOMPLETE.SUBPROJECTID, TBLPRJTCOSTATCOMPLETE.PROJECTID" _
& ", Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='P',[TBLPRJTCOSTATCOMPLETE]![COSTATCOMPLETION],0)) AS PlanEst, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='P',[TBLPRJTCOSTATCOMPLETE]![APCEAMOUNT],0)) AS PlanApprv, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='P',[TBLPRJTCOSTATCOMPLETE]![LTDEXP],0)) AS PlanLTD, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='A',[TBLPRJTCOSTATCOMPLETE]![COSTATCOMPLETION],0)) AS DesignEst" _
& ", Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='A',[TBLPRJTCOSTATCOMPLETE]![APCEAMOUNT],0)) AS DesignApprv, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='A',[TBLPRJTCOSTATCOMPLETE]![LTDEXP],0)) AS DesignLTD, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='B',[TBLPRJTCOSTATCOMPLETE]![COSTATCOMPLETION],0)) AS ROWEst, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='B',[TBLPRJTCOSTATCOMPLETE]![APCEAMOUNT],0)) AS ROWApprv" _
& ", Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='B',[TBLPRJTCOSTATCOMPLETE]![LTDEXP],0)) AS ROWLTD" _
& ", Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='C',[TBLPRJTCOSTATCOMPLETE]![COSTATCOMPLETION],0)) AS ConEst, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='C',[TBLPRJTCOSTATCOMPLETE]![APCEAMOUNT],0)) AS ConApprv, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![PHASE]='C',[TBLPRJTCOSTATCOMPLETE]![LTDEXP],0)) AS ConLTD " _
& " FROM TBLPRJTCOSTATCOMPLETE " _
& " WHERE (((TBLPRJTCOSTATCOMPLETE.CACMNTH)=Month(Date())) AND ((TBLPRJTCOSTATCOMPLETE.CACYR)=Year(Date())) AND ((TBLPRJTCOSTATCOMPLETE.SUBPROJECTID)='" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_SubprojectID] & "'))" _
& " GROUP BY TBLPRJTCOSTATCOMPLETE.CACMNTH, TBLPRJTCOSTATCOMPLETE.CACYR, TBLPRJTCOSTATCOMPLETE.SUBPROJECTID, TBLPRJTCOSTATCOMPLETE.PROJECTID) AS zzCost" _
& " RIGHT JOIN TBLSUBPROJECTINFORMATION ON zzCost.SUBPROJECTID = TBLSUBPROJECTINFORMATION.SUBPROJECTID" _
& " WHERE (((zzCost.SUBPROJECTID)='" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_SubprojectID] & "'));"
'Load the Cost at Complete Values into the variables
rst.Open sSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
If rst!CONSTRCOSTNOTRQD = -1 And rst!DESIGNCOSTNOTRQD = -1 Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#D8D8D8>n </font>"
rst.MoveLast
Else
dblPlanEst = rst!PlanEst
dblDesignEst = rst!DesignEst
dblROWEst = rst!ROWEst
dblConEst = rst!ConEst
dblPlanApprv = rst!PlanApprv
dblDesignApprv = rst!DesignApprv
dblROWApprv = rst!ROWApprv
dblConApprv = rst!ConApprv
dblPlanLTD = rst!PlanLTD
dblDesignLTD = rst!designLTD
dblROWLTD = rst!ROWLTD
dblConLTD = rst!ConLTD
'Load the Cost Status function
stCostVarCat = costStatus(dblPlanEst, dblDesignEst, dblROWEst, dblConEst, dblPlanApprv, dblDesignApprv, dblROWApprv, dblConApprv, dblPlanLTD, dblDesignLTD, dblROWLTD, dblConLTD)
'Determine the Color for the Form
If stCostVarCat = "Major" Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#ED1C24>n </font>"
Me.txtCostRYG.Value = "R"
ElseIf stCostVarCat = "Minor" Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#FFF20C>n </font>"
Me.txtCostRYG.Value = "Y"
ElseIf stCostVarCat = "Micro" Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#22B14C>n </font>"
Me.txtCostRYG.Value = "G"
ElseIf stCostVarCat = "NoB" Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
End If
End If
'Schedule Indicator__________________________
'Open recordset
Set rst2 = New ADODB.Recordset
'Pull the Schedule values
sSQL2Select = "SELECT ZZCURRENTMILESTONEDATES.RPTYEAR, ZZCURRENTMILESTONEDATES.RPTMNTH, TBLSUBPROJECTINFORMATION.SUBPROJECTID" _
& ", TBLSUBPROJECTINFORMATION.SCHDNOTRQD, qrptMgmtSched2CurrentMilestone.ABBRV AS CM" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Design Start',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS MilestoneDS" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='30% Submittal',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS Milestone30" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='60% Submittal',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS Milestone60" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='90% Submittal',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS Milestone90" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='100% Submittal',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS Milestone100" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Advertise',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS MilestoneAd" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice to Proceed',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS MilestoneNTP" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice of Substantial Completion',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS MilestoneSC" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice of Physical Completion',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)) AS MilestonePC" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Close Contract',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Release Retainage',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Acceptance Recommendation',[ZZCURRENTMILESTONEDATES]![SCHEDULEDATE],Null)))) AS MilestoneCC" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Design Start',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS BaseDS" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='30% Submittal',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS Base30" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='60% Submittal',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS Base60" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='90% Submittal',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS Base90" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='100% Submittal',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS Base100" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Advertise',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS BaseAd" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice to Proceed',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS BaseNTP" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice of Substantial Completion',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS BaseSC" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Issue Notice of Physical Completion',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)) AS BasePC" _
& ", Max(IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Close Contract',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Release Retainage',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],IIf([ZZCURRENTMILESTONEDATES]![MILESTONETASK]='Acceptance Recommendation',[ZZCURRENTMILESTONEDATES]![BASELINEDATE],Null)))) AS BaseCC"
sSQL2From = "FROM (TBLSUBPROJECTINFORMATION" _
& " LEFT JOIN qrptMgmtSched2CurrentMilestone ON TBLSUBPROJECTINFORMATION.SUBPROJECTID = qrptMgmtSched2CurrentMilestone.SubprojectID)" _
& " LEFT JOIN (SELECT TBLPROJECTOFFICEMILESTONEDATES.MILESTONEANBR, TBLPROJECTOFFICEMILESTONEDATES.RPTYEAR, TBLPROJECTOFFICEMILESTONEDATES.RPTMNTH, TBLPROJECTOFFICEMILESTONEDATES.SUBPROJECTID, TBLPROJECTOFFICEMILESTONEDATES.MILESTONETASK, TBLPROJECTOFFICEMILESTONEDATES.BASELINEDATE, TBLPROJECTOFFICEMILESTONEDATES.SCHEDULEDATE, TBLPROJECTOFFICEMILESTONEDATES.FORECASTEDDATE, TBLPROJECTOFFICEMILESTONEDATES.ACTUALDATE, TBLPROJECTOFFICEMILESTONEDATES.DOWNLOADDATE" _
& " FROM TBLPROJECTOFFICEMILESTONEDATES" _
& " WHERE (((TBLPROJECTOFFICEMILESTONEDATES.RPTYEAR)=" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_ExpYr] & ")" _
& " AND ((TBLPROJECTOFFICEMILESTONEDATES.RPTMNTH)=" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_ExpMnth] & "))) AS ZZCURRENTMILESTONEDATES" _
& " ON TBLSUBPROJECTINFORMATION.SUBPROJECTID = ZZCURRENTMILESTONEDATES.SUBPROJECTID"
sSQL2Where = "WHERE (((TBLSUBPROJECTINFORMATION.SubprojectID)='" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_SubprojectID] & "'))"
sSQL2group = "GROUP BY ZZCURRENTMILESTONEDATES.RPTYEAR, ZZCURRENTMILESTONEDATES.RPTMNTH, TBLSUBPROJECTINFORMATION.SUBPROJECTID" _
& ", TBLSUBPROJECTINFORMATION.SCHDNOTRQD, qrptMgmtSched2CurrentMilestone.ABBRV"
sSQL2 = sSQL2Select & vbCrLf & sSQL2From & vbCrLf & sSQL2Where & vbCrLf & sSQL2group & ";"
' Debug.Print "sSQL2: " & sSQL2
'Load the Schedule values into the variables
rst2.Open sSQL2, CurrentProject.Connection, adOpenStatic, adLockReadOnly
If rst2!SCHDNOTRQD = -1 Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#D8D8D8>n </font>"
rst.MoveLast
ElseIf IsNull(rst2!CM) Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
Else
strCM = rst2!CM
dteMilestoneDS = rst2!milestoneDS
dteMilestone30 = rst2!milestone30
dteMilestone60 = rst2!milestone60
dteMilestone90 = rst2!milestone90
dteMilestone100 = rst2!milestone100
dteMilestoneAd = rst2!milestoneAd
dteMilestoneNTP = rst2!milestoneNTP
dteMilestoneSC = rst2!milestoneSC
dteMilestonePC = rst2!milestonePC
dteMilestoneCC = rst2!milestoneCC
dteBaseDS = rst2!baseDS
dteBase30 = rst2!base30
dteBase60 = rst2!base60
dteBase90 = rst2!base90
dteBase100 = rst2!base100
dteBaseAd = rst2!baseAd
dteBaseNTP = rst2!baseNTP
dteBaseSC = rst2!baseSC
dteBasePC = rst2!basePC
dteBaseCC = rst2!baseCC
'Load the Schedule Status function
stSchedVarCat = schedStatus(strCM, dteMilestoneDS, dteMilestone30, dteMilestone60, dteMilestone90, dteMilestone100, dteMilestoneAd, dteMilestoneNTP, dteMilestoneSC, dteMilestonePC, dteMilestoneCC, dteBaseDS, dteBase30, dteBase60, dteBase90, dteBase100, dteBaseAd, dteBaseNTP, dteBaseSC, dteBasePC, dteBaseCC)
'Determine the Color for the Form
If stSchedVarCat = "Major" Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#ED1C24>n </font>"
Me.txtSchedRYG.Value = "R"
ElseIf stSchedVarCat = "Minor" Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#FFF20C>n </font>"
Me.txtSchedRYG.Value = "Y"
ElseIf stSchedVarCat = "Micro" Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#22B14C>n </font>"
Me.txtSchedRYG.Value = "G"
ElseIf stSchedVarCat = "" Or IsNull(stSchedVarCat) Then
Me.txtSchedVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
End If
End If
'Secured Funding Indicator__________________________
'Open recordset
Set rst3 = New ADODB.Recordset
sSQL3 = " SELECT TBLPRJTCOSTATCOMPLETE.SUBPROJECTID, TBLSUBPROJECTCCBAMTS.SECUREDFUNDINGAMT" _
& ", Sum(TBLPRJTCOSTATCOMPLETE.APCEAMOUNT) AS APCEAMOUNT, Sum(IIf([TBLPRJTCOSTATCOMPLETE]![LTDEXP] Is Null,0,[TBLPRJTCOSTATCOMPLETE]![LTDEXP])) AS LTDEXP, Sum(TBLPRJTCOSTATCOMPLETE.COSTATCOMPLETION) AS COSTATCOMPLETE" _
& ", TBLSUBPROJECTINFORMATION.DESIGNCOSTNOTRQD, TBLSUBPROJECTINFORMATION.CONSTRCOSTNOTRQD, TBLSUBPROJECTCCBAMTS.FUNDINGPENDING, TBLSUBPROJECTCCBAMTS.FUNDINGPENDINGNOTE" _
& " FROM TBLSUBPROJECTINFORMATION" _
& " INNER JOIN (TBLPRJTCOSTATCOMPLETE INNER JOIN TBLSUBPROJECTCCBAMTS ON (TBLPRJTCOSTATCOMPLETE.SUBPROJECTID = TBLSUBPROJECTCCBAMTS.SUBPROJECTID)" _
& " AND (TBLPRJTCOSTATCOMPLETE.CACMNTH = TBLSUBPROJECTCCBAMTS.CCBAMTMONTH) AND (TBLPRJTCOSTATCOMPLETE.CACYR = TBLSUBPROJECTCCBAMTS.CCBAMTYEAR))" _
& " ON (TBLSUBPROJECTINFORMATION.PROJECTID = TBLPRJTCOSTATCOMPLETE.PROJECTID) AND (TBLSUBPROJECTINFORMATION.SUBPROJECTID = TBLPRJTCOSTATCOMPLETE.SUBPROJECTID)" _
& " WHERE (((TBLPRJTCOSTATCOMPLETE.CACYR)=Year(Date()))" _
& " AND ((TBLPRJTCOSTATCOMPLETE.CACMNTH)=Month(Date()))" _
& " AND ((TBLPRJTCOSTATCOMPLETE.SUBPROJECTID)='" & [Forms]![frmPMInfoMgmtTool_ProjSelect]![cmb_SubprojectID] & "'))" _
& " GROUP BY TBLPRJTCOSTATCOMPLETE.SUBPROJECTID, TBLSUBPROJECTCCBAMTS.SECUREDFUNDINGAMT" _
& ", TBLSUBPROJECTINFORMATION.DESIGNCOSTNOTRQD, TBLSUBPROJECTINFORMATION.CONSTRCOSTNOTRQD, TBLSUBPROJECTCCBAMTS.FUNDINGPENDING, TBLSUBPROJECTCCBAMTS.FUNDINGPENDINGNOTE;"
'Load the Secured Funding Values into the variables
rst3.Open sSQL3, CurrentProject.Connection, adOpenStatic, adLockReadOnly
'Blank: Design Cost Estimates AND Construction Cost Estimates are NOT required
If rst3!CONSTRCOSTNOTRQD = -1 And rst3!DESIGNCOSTNOTRQD = -1 Then
Me.txtCostVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
rst.MoveLast
Else
If IsNull(rst3!SECUREDFUNDINGAMT) Then
dblSecFundAmt = 0
Else
dblSecFundAmt = rst3!SECUREDFUNDINGAMT
End If
If IsNull(rst3!APCEAmount) Then
dblAPCEAmt = 0
Else
dblAPCEAmt = rst3!APCEAmount
End If
If IsNull(rst3!LTDExp) Then
dblLTDExp = 0
Else
dblLTDExp = rst3!LTDExp
End If
If IsNull(rst3!CostAtComplete) Then
dblCAC = 0
Else
dblCAC = rst3!CostAtComplete
End If
If IsNull(rst3!FUNDINGPENDING) Then
blnFndPnd = False
Else
blnFndPnd = rst3!FUNDINGPENDING
End If
Debug.Print "blnFndPnd (Funding Pending) Value = " & blnFndPnd
'Load the Secured Funding Indicator______________________
stSecdFundVarCat = FundingStatus(dblAPCEAmt, dblLTDExp, dblCAC, dblSecFundAmt, blnFndPnd)
'Determine the Color for the Form
If stSecdFundVarCat = "Major" Then
Me.txtSecdFundVarCat.Value = "<font face=Webdings size=3 color=#ED1C24>n </font>"
Me.txtSecdFundRYG.Value = "R"
ElseIf stSecdFundVarCat = "Minor" Then
Me.txtSecdFundVarCat.Value = "<font face=Webdings size=3 color=#FFF20C>n </font>"
Me.txtSecdFundRYG.Value = "Y"
ElseIf stSecdFundVarCat = "Micro" Then
Me.txtSecdFundVarCat.Value = "<font face=Webdings size=3 color=#22B14C>n </font>"
Me.txtSecdFundRYG.Value = "G"
ElseIf stSecdFundVarCat = "NoB" Then
Me.txtSecdFundVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
'Me.txtSecdFundRYG.Value = "G"
ElseIf stSecdFundVarCat = "" Or IsNull(stSecdFundVarCat) Then
Me.txtSecdFundVarCat.Value = "<font face=Webdings size=3 color=#8C8C8C>n </font>"
End If
End If
intCallCount = intCallCount + 1
End If
' Close ADO objects
rst.Close
rst2.Close
rst3.Close
Conn.Close
Set rst = Nothing
Set rst2 = Nothing
Set rst3 = Nothing
Set Conn = Nothing
Exit_Form_Load:
' Debug.Print Me.Name & " Form Load Completed at: " & Now()
Exit Sub
Err_Form_Load:
If Err.Number = 2450 Then
Exit Sub
Else
MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description _
, vbCritical + vbOKOnly, "Error Loading Form: " & Form.Caption
Resume Exit_Form_Load
End If
End Sub
Comment