By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,969 Members | 1,810 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,969 IT Pros & Developers. It's quick & easy.

Extracting Useful Information From Contracts - VBA Code Example

100+
P: 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]
Dec 19 '06 #1
Share this Question
Share on Google+
4 Replies


100+
P: 153
No clue what's up with the color scheme
Dec 20 '06 #2

MMcCarthy
Expert Mod 10K+
P: 14,534
No clue what's up with the color scheme
you used php instead of code tags. doesn't recognise the apostrophe as a comment.

Mary
Dec 20 '06 #3

100+
P: 153
yeah...I figured...I just don't like the color scheme :) If I had used quotes it would have gotten rid of all the indents and those who were not familiar with what is going on would have been utterly confused.
Dec 20 '06 #4

100+
P: 153
Thanks to the help of willakawill, I have added further functionality to this code...and Willakawill cleaned it up for an easier to read version. This new version adds outlook notification that is sent to outlook as an appointment after checking if it has already been added or not. Remember, this code was done by myself with the help of you guys and so it is only fair to give back and I like to give back anyways....but, it was created while in the employ of my company so you may only use it for reference whatever that means :)

The code can be found here: http://www.thescripts.com/forum/thread581521.html

Cheers :)

Kosmös
Dec 28 '06 #5

Post your reply

Sign in to post your reply or Sign up for a free account.