153
Hey guys...as a relatively new programmer, I try to give back where I can. Below is the code for a useful program I believe many of you could use...just don't use the same exact code because...well I don't work for myself if you get my drift....anyways even if this is not asked of you...it might get you on friendly terms with the lawyers in the office
The code is written to extract information from a table with contract information and divide it up into the number of days left until the end of the contract or required notification of renewal or non-renewal (and then information based off of that such as terms of late termination or what not) etc... The user is prompted to give a number of days notice before these events and based on the status the contracts that apply are divided into four tables such as contracts that have ended, contracts that require notification within that amount of days, contracts that will end in that number of days, and contracts that will end within that number of days but have passed their expiration. This is all done with VBA in a module instead of using querries...I feel more comfortable using VBA for some reason....Obviously you would have to create the tables and fields so the information can be inserted and customize it, of course, for your own purposes. I have added commentary to help you follow what I am doing if you are not very familiar with VBA as I was not just a short time ago...if you are still confused, some of the lessons from this site (http://www.functionx.com/vbaccess/Lesson01.htm) might help you follow along a little better. You might also want to add some security once you're fully finished so only certain users can edit the main contract folder. With this information you could export a report through event code in a form that would allow the user options such as exporting the report to word or excel or even offer both options....anyways here it is:
[PHP]Private Sub DaysToCompletion()
'Opening ADODB connections and record sets
Dim con1 As ADODB.Connection
Dim con2 As ADODB.Connection
Dim con3 As ADODB.Connection
Dim con4 As ADODB.Connection
Dim con5 As ADODB.Connection
Dim recSet1 As ADODB.Recordset
Dim recSet2 As ADODB.Recordset
Dim recSet3 As ADODB.Recordset
Dim recSet4 As ADODB.Recordset
Dim recSet5 As ADODB.Recordset
Set con1 = CurrentProject.Connection
Set con2 = CurrentProject.Connection
Set con3 = CurrentProject.Connection
Set con4 = CurrentProject.Connection
Set con5 = CurrentProject.Connection
Set recSet1 = New ADODB.Recordset
Set recSet2 = New ADODB.Recordset
Set recSet3 = New ADODB.Recordset
Set recSet4 = New ADODB.Recordset
Set recSet5 = New ADODB.Recordset
'setting records and connections to actual tables (and allowing editing capabilities to temporary tables but not the Contracts table)
recSet1.Open "tblContracts", con1, , adLockReadOnly
recSet2.Open "NotEndedPastRenewalX", con2, adOpenKeyset, adLockOptimistic
recSet3.Open "NotificationX", con3, adOpenKeyset, adLockOptimistic
recSet4.Open "ContractEndX", con4, adOpenKeyset, adLockOptimistic
recSet5.Open "ExpiredX", con5, adOpenKeyset, adLockOptimistic
Dim x As Long
'In context of the form this will open in, asking user for the number of days notification before contract end or notification or non-renewal (or renewal)
x = InputBox("Enter the number of days:")
'Declaring UntilCompletion as the amount of days until completion and UntilCompletion2 will be number of days until required notification
Dim UntilCompletion As Long
Dim UntilCompletion2 As Long
'Looping until EOF (until the last record for EndDate in tblContracts...so
'someone else would have declared recSet1.Open
'"tblWhateverYourTableNameIs", con1 which means
'connection1 and then to open a field in that recordset you type
'recSet1.Fields("fieldname"))
recSet1.MoveFirst
Do Until recSet1.EOF
' End Date must be in quotes or will not work
UntilCompletion = DateDiff("d", Date, recSet1.Fields("EndDate"))
UntilCompletion2 = DateDiff("d", Date, recSet1.Fields("NotificationDate"))
' For Debugging purposes...check in immediate window
Debug.Print x
Debug.Print UntilCompletion
Debug.Print UntilCompletion2
If UntilCompletion2 >= 0 And UntilCompletion2 <= x Then
'Must say rs.AddNew and rs.Update before and after updating fields
'Captures contracts that require notification within the next x number of days
recSet3.AddNew
recSet3.Fields("UntilNotification") = UntilCompletion2
recSet3.Fields("Vendor") = recSet1.Fields("Vendor")
recSet3.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress")
recSet3.Fields("DateofContract") = recSet1.Fields("DateofContract")
recSet3.Fields("NotificationDate") = recSet1.Fields("NotificationDate")
recSet3.Fields("TermofContract") = recSet1.Fields("TermofContract")
recSet3.Fields("EndDate") = recSet1.Fields("EndDate")
recSet3.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees")
recSet3.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal")
recSet3.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause")
recSet3.Update
End If
If UntilCompletion >= 0 And UntilCompletion <= x Then
'Captures contracts that end within the next x number of days
recSet4.AddNew
recSet4.Fields("UntilContractEnd") = UntilCompletion
recSet4.Fields("Vendor") = recSet1.Fields("Vendor")
recSet4.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress")
recSet4.Fields("DateofContract") = recSet1.Fields("DateofContract")
recSet4.Fields("NotificationDate") = recSet1.Fields("NotificationDate")
recSet4.Fields("TermofContract") = recSet1.Fields("TermofContract")
recSet4.Fields("EndDate") = recSet1.Fields("EndDate")
recSet4.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees")
recSet4.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal")
recSet4.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause")
recSet4.Update
If UntilCompletion2 <= UntilCompletion And UntilCompletion2 < 0 Then
'Captures contracts that end within the next x number of days but have expired
UntilCompletion2 = (UntilCompletion2 * (-1))
recSet2.AddNew
recSet2.Fields("PastRenewalDate") = UntilCompletion2
recSet2.Fields("Vendor") = recSet1.Fields("Vendor")
recSet2.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress")
recSet2.Fields("DateofContract") = recSet1.Fields("DateofContract")
recSet2.Fields("NotificationDate") = recSet1.Fields("NotificationDate")
recSet2.Fields("TermofContract") = recSet1.Fields("TermofContract")
recSet2.Fields("EndDate") = recSet1.Fields("EndDate")
recSet2.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees")
recSet2.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal")
recSet2.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause")
recSet2.Update
End If
ElseIf UntilCompletion < 0 Then
'Captures contracts that have expired and are presented in a table which the user can use in order to delete information they no longer need if they have proper access
UntilCompletion = (UntilCompletion * (-1))
recSet5.AddNew
recSet5.Fields("PastExpiration") = UntilCompletion
recSet5.Fields("Vendor") = recSet1.Fields("Vendor")
recSet5.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress")
recSet5.Fields("DateofContract") = recSet1.Fields("DateofContract")
recSet5.Fields("NotificationDate") = recSet1.Fields("NotificationDate")
recSet5.Fields("TermofContract") = recSet1.Fields("TermofContract")
recSet5.Fields("EndDate") = recSet1.Fields("EndDate")
recSet5.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees")
recSet5.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal")
recSet5.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause")
recSet5.Update
End If
recSet1.MoveNext
Loop
'Closing connections and clearing record sets
recSet1.Close
recSet2.Close
recSet3.Close
recSet4.Close
recSet5.Close
con1.Close
con2.Close
con3.Close
con4.Close
con5.Close
Set con1 = Nothing
Set con2 = Nothing
Set con3 = Nothing
Set con4 = Nothing
Set con5 = Nothing
Set recSet1 = Nothing
Set recSet2 = Nothing
Set recSet3 = Nothing
Set recSet4 = Nothing
Set recSet5 = Nothing
End Sub[/PHP]
