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

Using DLookup

100+
P: 153
Hey guys...I've never used DLookup before...
I'm just simply wondering how to use it. I have to check a field to see if it has been entered before. The field is in recSet6.Fields("DatabaseReferenceNumber") which I have to check to see if it has any matches to a specific recSet1.Fields("DatabaseReferenceNumber") which is counted through a Do Until recSet1.EOF kinda loop (which goes from 1 until the end of the field, but the recSet1.Fields("DatabaseReferenceNumber") I am checking against is not always one after another due to multiple IF statements within the loop). Any help with this would be much appreciated.
Dec 27 '06 #1
Share this Question
Share on Google+
19 Replies


100+
P: 153
actually I'm not even sure if I'm correct in using the DLookup function, I just need a function that will return a true/false value depending on whether or not the other value is found in that field.
Dec 27 '06 #2

100+
P: 1,646
actually I'm not even sure if I'm correct in using the DLookup function, I just need a function that will return a true/false value depending on whether or not the other value is found in that field.
Hi. Help is in ample supply to those who are willing to post code :)
Dec 27 '06 #3

100+
P: 153
well I hope you do not mean that you think I don't ever post code...you can look at some of my previous posts with respect to that...but assuming you did not mean that...sure here's the whole function with many comments but I put the comment where I'm specifically looking at in CAPITALS :)



[PHP]Private Sub cmdAddToOutlook_Click()
On Error GoTo Err_cmdAddToOutlook_Click

DoCmd.SetWarnings False
DoCmd.OpenQuery ("CleartblContractsTemp")

Dim stDocName As String

stDocName = "FindVendorContracts"
DoCmd.OpenQuery stDocName, acNormal, acEdit




DoCmd.OpenQuery ("ClearNotificationXTable")
DoCmd.OpenQuery ("ClearNotEndedPastRenewalXTable")
DoCmd.OpenQuery ("ClearContractEndXTables")
DoCmd.OpenQuery ("ClearExpiredXTables")

'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 con6 As ADODB.Connection
Dim con7 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
Dim recSet6 As ADODB.Recordset
Dim recSet7 As ADODB.Recordset
Set con1 = CurrentProject.Connection
Set con2 = CurrentProject.Connection
Set con3 = CurrentProject.Connection
Set con4 = CurrentProject.Connection
Set con5 = CurrentProject.Connection
Set con6 = CurrentProject.Connection
Set con7 = 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
Set recSet6 = New ADODB.Recordset
Set recSet7 = New ADODB.Recordset

'setting records and connections to actual tables (and allowing editing capabilities to temporary tables and the table that checks if the appointment has already been sent to Outlook, but not the Contracts table)
recSet1.Open "tblContractsTemp", con1, , adLockOptimistic
recSet2.Open "NotEndedPastRenewalX", con2, adOpenKeyset, adLockOptimistic
recSet3.Open "NotificationX", con3, adOpenKeyset, adLockOptimistic
recSet4.Open "ContractEndX", con4, adOpenKeyset, adLockOptimistic
recSet5.Open "ExpiredX", con5, adOpenKeyset, adLockOptimistic
recSet6.Open "AddedToOutlook", con6, adOpenKeyset, adLockOptimistic
recSet7.Open "tblContracts", con7, adOpenKeyset, adLockReadOnly

Dim X As Long
Dim Y As Long
Y = 0
'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("EndDate2"))
recSet1.Fields("NotificationDate2") = (recSet1.Fields("EndDate2") - recSet1.Fields("RequiredNotificationInDays2"))
UntilCompletion2 = DateDiff("d", Date, recSet1.Fields("NotificationDate2"))


' 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("Vendor2")
recSet3.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress2")
recSet3.Fields("RequiredNotificationInDays") = recSet1.Fields("RequiredNotificationInDays2")
recSet3.Fields("DateofContract") = recSet1.Fields("DateofContract2")
recSet3.Fields("NotificationDate") = recSet1.Fields("NotificationDate2")
recSet3.Fields("TermofContract") = recSet1.Fields("TermofContract2")
recSet3.Fields("EndDate") = recSet1.Fields("EndDate2")
recSet3.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees2")
recSet3.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal2")
recSet3.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause2")
recSet3.Fields("OwnerName") = recSet1.Fields("OwnerName2")
recSet3.Fields("City") = recSet1.Fields("City2")
recSet3.Fields("Department") = recSet1.Fields("Department2")
recSet3.Fields("LicensedUse") = recSet1.Fields("LicensedUse2")
recSet3.Update


'THIS IS WHERE I WANT TO CHECK IF THERE IS A VALUE ALREADY IN THIS SEPARATE TABLE recSet6.Fields("DatabaseReferenceNumber")
'IT IS A CHECK TO MAKE SURE I HAVE NOT ALREADY ADDED IT TO OUTLOOK

recSet6.AddNew
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.Start = recSet1.Fields("NotificationDate2") & " " & recSet1.Fields("ApptTime2")
.Duration = 15
.Subject = "Contract Notification/End" & " " & recSet1.Fields("DatabaseReferenceNumber2") & " " & recSet1.Fields("Vendor2")
.Body = "Contract Notification/End" & " " & recSet1.Fields("DatabaseReferenceNumber2") & " " & recSet1.Fields("Vendor2")
.ReminderMinutesBeforeStart = recSet1.Fields("ReminderMinutes2")
.ReminderSet = True
.Save
End With
recSet6.Fields("AddedToOutlook") = True
recSet6.Fields("DatabaseReferenceNumber") = recSet1.Fields("DatabaseReferenceNumber2")
Set outobj = Nothing
DoCmd.RunCommand acCmdSaveRecord
recSet6.Update
recSet6.MoveNext

End If


[/PHP]
Dec 27 '06 #4

100+
P: 153
Function continued since was too long (in case anyone wanted to follow) [I have posted a similar function to this before, however, that is easier to follow but doesn't have this extra adding appointments to outlook section in there]:
[PHP]

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("Vendor2")
recSet4.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress2")
recSet4.Fields("RequiredNotificationInDays") = recSet1.Fields("RequiredNotificationInDays2")
recSet4.Fields("DateofContract") = recSet1.Fields("DateofContract2")
recSet4.Fields("NotificationDate") = recSet1.Fields("NotificationDate2")
recSet4.Fields("TermofContract") = recSet1.Fields("TermofContract2")
recSet4.Fields("EndDate") = recSet1.Fields("EndDate2")
recSet4.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees2")
recSet4.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal2")
recSet4.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause2")
recSet4.Fields("OwnerName") = recSet1.Fields("OwnerName2")
recSet4.Fields("City") = recSet1.Fields("City2")
recSet4.Fields("Department") = recSet1.Fields("Department2")
recSet4.Fields("LicensedUse") = recSet1.Fields("LicensedUse2")
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("Vendor2")
recSet2.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress2")
recSet2.Fields("RequiredNotificationInDays") = recSet1.Fields("RequiredNotificationInDays2")
recSet2.Fields("DateofContract") = recSet1.Fields("DateofContract2")
recSet2.Fields("NotificationDate") = recSet1.Fields("NotificationDate2")
recSet2.Fields("TermofContract") = recSet1.Fields("TermofContract2")
recSet2.Fields("EndDate") = recSet1.Fields("EndDate2")
recSet2.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees2")
recSet2.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal2")
recSet2.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause2")
recSet2.Fields("OwnerName") = recSet1.Fields("OwnerName2")
recSet2.Fields("City") = recSet1.Fields("City2")
recSet2.Fields("Department") = recSet1.Fields("Department2")
recSet2.Fields("LicensedUse") = recSet1.Fields("LicensedUse2")
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("Vendor2")
recSet5.Fields("NotificationAddress") = recSet1.Fields("NotificationAddress2")
recSet5.Fields("RequiredNotificationInDays") = recSet1.Fields("RequiredNotificationInDays2")
recSet5.Fields("DateofContract") = recSet1.Fields("DateofContract2")
recSet5.Fields("NotificationDate") = recSet1.Fields("NotificationDate2")
recSet5.Fields("TermofContract") = recSet1.Fields("TermofContract2")
recSet5.Fields("EndDate") = recSet1.Fields("EndDate2")
recSet5.Fields("PaymentTerms/LateFees") = recSet1.Fields("PaymentTerms/LateFees2")
recSet5.Fields("AutomaticRenewal") = recSet1.Fields("AutomaticRenewal2")
recSet5.Fields("EarlyOutClause") = recSet1.Fields("EarlyOutClause2")
recSet5.Fields("OwnerName") = recSet1.Fields("OwnerName2")
recSet5.Fields("City") = recSet1.Fields("City2")
recSet5.Fields("Department") = recSet1.Fields("Department2")
recSet5.Fields("LicensedUse") = recSet1.Fields("LicensedUse2")
recSet5.Update

End If

recSet1.MoveNext
Loop

'Closing connections and clearing record sets
recSet1.Close
recSet2.Close
recSet3.Close
recSet4.Close
recSet5.Close
recSet6.Close
recSet7.Close
con1.Close
con2.Close
con3.Close
con4.Close
con5.Close
con6.Close
con7.Close
Set con1 = Nothing
Set con2 = Nothing
Set con3 = Nothing
Set con4 = Nothing
Set con5 = Nothing
Set con6 = Nothing
Set con7 = Nothing
Set recSet1 = Nothing
Set recSet2 = Nothing
Set recSet3 = Nothing
Set recSet4 = Nothing
Set recSet5 = Nothing
Set recSet6 = Nothing
Set recSet7 = Nothing
Y = 0

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "NotificationX", "C:\ContractReports\PersonalizedContractReport_Imp ortantDates", True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ContractEndX", "C:\ContractReports\PersonalizedContractReport_Imp ortantDates", True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "NotEndedPastRenewalX", "C:\ContractReports\PersonalizedContractReport_Imp ortantDates", True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ExpiredX", "C:\ContractReports\PersonalizedContractReport_Imp ortantDates", True

DoCmd.OpenQuery ("ClearNotificationXTable")
DoCmd.OpenQuery ("ClearNotEndedPastRenewalXTable")
DoCmd.OpenQuery ("ClearContractEndXTables")
DoCmd.OpenQuery ("ClearExpiredXTables")
DoCmd.OpenQuery ("CleartblContractsTemp")




'CommandBars("Menu Bar"). _
'Controls("Tools"). _
'Controls("Database utilities"). _
'Controls("Compact and repair database..."). _
'accDoDefaultAction

DoCmd.SetWarnings True




Exit_cmdAddToOutlook_Click:
Exit Sub

Err_cmdAddToOutlook_Click:
MsgBox Err.Description
Resume Exit_cmdAddToOutlook_Click
End Sub[/PHP]
Dec 27 '06 #5

100+
P: 153
I basically know what I want to do: It's an If statement that would ask:

IsNull(Dlookup( of recSet6.Fields"DatabaseReferenceNumber" where is equal to recSet1.Fields("DatabaseReferenceNumber") which will be a specific number at that time)

I'm just not sure how to format what's inside of the DLookup when using integers.
The actual table names for recSet1 and recSet6 are 'tblContractsTemp' for recSet1 and 'AddedToOutlook' for recSet6
Dec 27 '06 #6

100+
P: 153
If IsNull(DLookup("[DatabaseReferenceNumber]", "AddedToOutlook", ("[DatabaseReferenceNumber]" = recSet1.Fields("DatabaseReferenceNumber2")))) Then

that's what I'm using...I'm getting no errors but It's coming up with a null every time which it shouldn't be...so it keeps on adding the three rows I currently have in the table so there is definetely a 1,2 and 3 in there and it's not finding it for some reason...am I setting the criteria in the wrong way?
Dec 27 '06 #7

100+
P: 1,646
If IsNull(DLookup("[DatabaseReferenceNumber]", "AddedToOutlook", ("[DatabaseReferenceNumber]" = recSet1.Fields("DatabaseReferenceNumber2")))) Then

that's what I'm using...I'm getting no errors but It's coming up with a null every time which it shouldn't be...so it keeps on adding the three rows I currently have in the table so there is definetely a 1,2 and 3 in there and it's not finding it for some reason...am I setting the criteria in the wrong way?
You can try this. It is different in quite a few ways from your original code
Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdAddToOutlook_Click()
  2.     On Error GoTo Err_cmdAddToOutlook_Click
  3.  
  4.     DoCmd.SetWarnings False
  5.     DoCmd.OpenQuery ("CleartblContractsTemp")
  6.  
  7.     Dim stDocName As String
  8.     Dim stSQL As String
  9.  
  10.     stDocName = "FindVendorContracts"
  11.     DoCmd.OpenQuery stDocName, acNormal, acEdit
  12.  
  13.  
  14.  
  15.  
  16.     DoCmd.OpenQuery ("ClearNotificationXTable")
  17.     DoCmd.OpenQuery ("ClearNotEndedPastRenewalXTable")
  18.     DoCmd.OpenQuery ("ClearContractEndXTables")
  19.     DoCmd.OpenQuery ("ClearExpiredXTables")
  20.  
  21.     'Opening ADODB connections and record sets
  22.     Dim con As ADODB.Connection
  23.  
  24.     Dim rsContTemp As ADODB.Recordset
  25.     Dim rsPastRen As ADODB.Recordset
  26.     Dim rsNotification As ADODB.Recordset
  27.     Dim rsContEnd As ADODB.Recordset
  28.     Dim rsExp As ADODB.Recordset
  29.     Dim rsOutlook As ADODB.Recordset
  30.     Dim rsContracts As ADODB.Recordset
  31.  
  32.     Set con = CurrentProject.Connection
  33.  
  34.     Set rsContTemp = New ADODB.Recordset
  35.     Set rsPastRen = New ADODB.Recordset
  36.     Set rsNotification = New ADODB.Recordset
  37.     Set rsContEnd = New ADODB.Recordset
  38.     Set rsExp = New ADODB.Recordset
  39.     Set rsOutlook = New ADODB.Recordset
  40.     Set rsContracts = New ADODB.Recordset
  41.  
  42.     'setting records and connections to actual tables (and allowing editing
  43.     'capabilities to temporary tables and the table that checks if the
  44.     'appointment has already been sent to Outlook, but not the Contracts table)
  45.     rsContTemp.Open "tblContractsTemp", con, , adLockOptimistic
  46.     rsPastRen.Open "NotEndedPastRenewalX", con, adOpenKeyset, adLockOptimistic
  47.     rsNotification.Open "NotificationX", con, adOpenKeyset, adLockOptimistic
  48.     rsContEnd.Open "ContractEndX", con, adOpenKeyset, adLockOptimistic
  49.     rsExp.Open "SELECT * FROM ExpiredX WHERE PastExpiration = -1", con, adOpenKeyset, adLockOptimistic
  50.     rsContracts.Open "tblContracts", con, adOpenKeyset, adLockReadOnly
  51.  
  52.     Dim X As Long
  53.     Dim Y As Long
  54.     Y = 0
  55.     'In context of the form this will open in, asking
  56.     'user for the number of days notification before
  57.     'contract end or notification or non-renewal (or renewal)
  58.     X = InputBox("Enter the number of days:")
  59.  
  60.     'Declaring UntilCompletion as the amount of days
  61.     'until completion and UntilCompletion2 will be
  62.     'number of days until required notification
  63.     Dim UntilCompletion As Long
  64.     Dim UntilCompletion2 As Long
  65.  
  66.     'Looping until EOF (until the last record for EndDate in tblContracts...so
  67.     'someone else would have declared rsContTemp.Open
  68.     '"tblWhateverYourTableNameIs", con1 which means
  69.     'connection1 and then to open a field in that recordset you type
  70.     'rsContTemp.Fields("fieldname"))
  71.  
  72.     rsContTemp.MoveFirst
  73.     Do Until rsContTemp.EOF
  74.       ' End Date must be in quotes or will not work
  75.       UntilCompletion = DateDiff("d", Date, rsContTemp.Fields("EndDate2"))
  76.       rsContTemp.Fields("NotificationDate2") = (rsContTemp.Fields("EndDate2") - rsContTemp.Fields("RequiredNotificationInDays2"))
  77.       UntilCompletion2 = DateDiff("d", Date, rsContTemp.Fields("NotificationDate2"))
  78.  
  79.  
  80.       ' For Debugging purposes...check in immediate window
  81.       Debug.Print X
  82.       Debug.Print UntilCompletion
  83.       Debug.Print UntilCompletion2
  84.  
  85.       If UntilCompletion2 >= 0 And UntilCompletion2 <= X Then
  86.             'Must say rs.AddNew and rs.Update before and after updating fields
  87.             'Captures contracts that require notification within the next x number of days
  88.             With rsNotification
  89.                 .AddNew
  90.                 .Fields("UntilNotification") = UntilCompletion2
  91.                 .Fields("Vendor") = rsContTemp.Fields("Vendor2")
  92.                 .Fields("NotificationAddress") = rsContTemp.Fields("NotificationAddress2")
  93.                 .Fields("RequiredNotificationInDays") = rsContTemp.Fields("RequiredNotificationInDays2")
  94.                 .Fields("DateofContract") = rsContTemp.Fields("DateofContract2")
  95.                 .Fields("NotificationDate") = rsContTemp.Fields("NotificationDate2")
  96.                 .Fields("TermofContract") = rsContTemp.Fields("TermofContract2")
  97.                 .Fields("EndDate") = rsContTemp.Fields("EndDate2")
  98.                 .Fields("PaymentTerms/LateFees") = rsContTemp.Fields("PaymentTerms/LateFees2")
  99.                 .Fields("AutomaticRenewal") = rsContTemp.Fields("AutomaticRenewal2")
  100.                 .Fields("EarlyOutClause") = rsContTemp.Fields("EarlyOutClause2")
  101.                 .Fields("OwnerName") = rsContTemp.Fields("OwnerName2")
  102.                 .Fields("City") = rsContTemp.Fields("City2")
  103.                 .Fields("Department") = rsContTemp.Fields("Department2")
  104.                 .Fields("LicensedUse") = rsContTemp.Fields("LicensedUse2")
  105.                 .Update
  106.             End With
  107.  
  108.  
Dec 27 '06 #8

100+
P: 1,646
Expand|Select|Wrap|Line Numbers
  1. 'THIS IS WHERE I WANT TO CHECK IF THERE IS A VALUE ALREADY IN THIS SEPARATE TABLE rsOutlook.Fields("DatabaseReferenceNumber")
  2. 'IT IS A CHECK TO MAKE SURE I HAVE NOT ALREADY ADDED IT TO OUTLOOK
  3.  
  4.                     stSQL = "SELECT * FROM AddedToOutlook WHERE DatabaseReferenceNumber = " _
  5.                             & rsContTemp("DatabaseReferenceNumber2")
  6.  
  7.                     rsOutlook.Open stSQL, con, adOpenKeyset, adLockOptimistic
  8.                     If rsOutlook.EOF Then
  9.                         rsOutlook.AddNew
  10.                         Dim outobj As Outlook.Application
  11.                         Dim outappt As Outlook.AppointmentItem
  12.                         Set outobj = CreateObject("outlook.application")
  13.                         Set outappt = outobj.CreateItem(olAppointmentItem)
  14.                             With outappt
  15.                                 .Start = rsContTemp.Fields("NotificationDate2") _
  16.                                     & " " & rsContTemp.Fields("ApptTime2")
  17.                                 .Duration = 15
  18.                                 .Subject = "Contract Notification/End" & " " _
  19.                                     & rsContTemp.Fields("DatabaseReferenceNumber2") _
  20.                                     & " " & rsContTemp.Fields("Vendor2")
  21.                                 .Body = "Contract Notification/End" & " " _
  22.                                     & rsContTemp.Fields("DatabaseReferenceNumber2") _
  23.                                     & " " & rsContTemp.Fields("Vendor2")
  24.                                 .ReminderMinutesBeforeStart = rsContTemp.Fields("ReminderMinutes2")
  25.                                 .ReminderSet = True
  26.                                 .Save
  27.                             End With
  28.                         rsOutlook.Fields("AddedToOutlook") = True
  29.                         rsOutlook.Fields("DatabaseReferenceNumber") = rsContTemp.Fields("DatabaseReferenceNumber2")
  30.                         Set outobj = Nothing
  31.                         'DoCmd.RunCommand acCmdSaveRecord
  32.                         rsOutlook.Update
  33.                     End If
  34.                     rsOutlook.Close
  35.                 End If
  36.              End If
  37.       If UntilCompletion >= 0 And UntilCompletion <= X Then
  38.             'Captures contracts that end within the next x number of days
  39.             With rsContEnd
  40.                 .AddNew
  41.                 .Fields("UntilContractEnd") = UntilCompletion
  42.                 .Fields("Vendor") = rsContTemp.Fields("Vendor2")
  43.                 .Fields("NotificationAddress") = rsContTemp.Fields("NotificationAddress2")
  44.                 .Fields("RequiredNotificationInDays") = rsContTemp.Fields("RequiredNotificationInDays2")
  45.                 .Fields("DateofContract") = rsContTemp.Fields("DateofContract2")
  46.                 .Fields("NotificationDate") = rsContTemp.Fields("NotificationDate2")
  47.                 .Fields("TermofContract") = rsContTemp.Fields("TermofContract2")
  48.                 .Fields("EndDate") = rsContTemp.Fields("EndDate2")
  49.                 .Fields("PaymentTerms/LateFees") = rsContTemp.Fields("PaymentTerms/LateFees2")
  50.                 .Fields("AutomaticRenewal") = rsContTemp.Fields("AutomaticRenewal2")
  51.                 .Fields("EarlyOutClause") = rsContTemp.Fields("EarlyOutClause2")
  52.                 .Fields("OwnerName") = rsContTemp.Fields("OwnerName2")
  53.                 .Fields("City") = rsContTemp.Fields("City2")
  54.                 .Fields("Department") = rsContTemp.Fields("Department2")
  55.                 .Fields("LicensedUse") = rsContTemp.Fields("LicensedUse2")
  56.                 .Update
  57.             End With
  58.  
  59.             If UntilCompletion2 <= UntilCompletion And UntilCompletion2 < 0 Then
  60.                 'Captures contracts that end within the next x number of days but have expired
  61.                 UntilCompletion2 = (UntilCompletion2 * (-1))
  62.                 With rsPastRen
  63.                     .AddNew
  64.                     .Fields("PastRenewalDate") = UntilCompletion2
  65.                     .Fields("Vendor") = rsContTemp.Fields("Vendor2")
  66.                     .Fields("NotificationAddress") = rsContTemp.Fields("NotificationAddress2")
  67.                     .Fields("RequiredNotificationInDays") = rsContTemp.Fields("RequiredNotificationInDays2")
  68.                     .Fields("DateofContract") = rsContTemp.Fields("DateofContract2")
  69.                     .Fields("NotificationDate") = rsContTemp.Fields("NotificationDate2")
  70.                     .Fields("TermofContract") = rsContTemp.Fields("TermofContract2")
  71.                     .Fields("EndDate") = rsContTemp.Fields("EndDate2")
  72.                     .Fields("PaymentTerms/LateFees") = rsContTemp.Fields("PaymentTerms/LateFees2")
  73.                     .Fields("AutomaticRenewal") = rsContTemp.Fields("AutomaticRenewal2")
  74.                     .Fields("EarlyOutClause") = rsContTemp.Fields("EarlyOutClause2")
  75.                     .Fields("OwnerName") = rsContTemp.Fields("OwnerName2")
  76.                     .Fields("City") = rsContTemp.Fields("City2")
  77.                     .Fields("Department") = rsContTemp.Fields("Department2")
  78.                     .Fields("LicensedUse") = rsContTemp.Fields("LicensedUse2")
  79.                     .Update
  80.                 End With
  81.             End If
  82.  
  83.         Else 'UntilCompletion < 0
  84.             'Captures contracts that have expired and are presented
  85.             'in a table which the user can use in order to delete
  86.             'information they no longer need if they have proper access
  87.             UntilCompletion = (UntilCompletion * (-1))
  88.             With rsExp
  89.                 .AddNew
  90.                 .Fields("PastExpiration") = UntilCompletion
  91.                 .Fields("Vendor") = rsContTemp.Fields("Vendor2")
  92.                 .Fields("NotificationAddress") = rsContTemp.Fields("NotificationAddress2")
  93.                 .Fields("RequiredNotificationInDays") = rsContTemp.Fields("RequiredNotificationInDays2")
  94.                 .Fields("DateofContract") = rsContTemp.Fields("DateofContract2")
  95.                 .Fields("NotificationDate") = rsContTemp.Fields("NotificationDate2")
  96.                 .Fields("TermofContract") = rsContTemp.Fields("TermofContract2")
  97.                 .Fields("EndDate") = rsContTemp.Fields("EndDate2")
  98.                 .Fields("PaymentTerms/LateFees") = rsContTemp.Fields("PaymentTerms/LateFees2")
  99.                 .Fields("AutomaticRenewal") = rsContTemp.Fields("AutomaticRenewal2")
  100.                 .Fields("EarlyOutClause") = rsContTemp.Fields("EarlyOutClause2")
  101.                 .Fields("OwnerName") = rsContTemp.Fields("OwnerName2")
  102.                 .Fields("City") = rsContTemp.Fields("City2")
  103.                 .Fields("Department") = rsContTemp.Fields("Department2")
  104.                 .Fields("LicensedUse") = rsContTemp.Fields("LicensedUse2")
  105.                 .Update
  106.             End With
  107.       End If
  108.  
  109.       rsContTemp.MoveNext
  110.     Loop
  111.  
  112.     'Closing connection and clearing record sets
  113.     rsContTemp.Close
  114.     rsPastRen.Close
  115.     rsNotification.Close
  116.     rsContEnd.Close
  117.     rsExp.Close
  118.     rsContracts.Close
  119.     con.Close
  120.  
  121.     Set con = Nothing
  122.  
  123.     Set rsContTemp = Nothing
  124.     Set rsPastRen = Nothing
  125.     Set rsNotification = Nothing
  126.     Set rsContEnd = Nothing
  127.     Set rsExp = Nothing
  128.     Set rsOutlook = Nothing
  129.     Set rsContracts = Nothing
  130.     Y = 0
  131.  
  132.     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "NotificationX", _
  133.         "C:\ContractReports\PersonalizedContractReport_Impo  rtantDates", True
  134.     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ContractEndX", _
  135.         "C:\ContractReports\PersonalizedContractReport_Impo  rtantDates", True
  136.     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "NotEndedPastRenewalX", _
  137.         "C:\ContractReports\PersonalizedContractReport_Impo  rtantDates", True
  138.     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ExpiredX", _
  139.         "C:\ContractReports\PersonalizedContractReport_Impo  rtantDates", True
  140.  
  141.   DoCmd.OpenQuery ("ClearNotificationXTable")
  142.   DoCmd.OpenQuery ("ClearNotEndedPastRenewalXTable")
  143.   DoCmd.OpenQuery ("ClearContractEndXTables")
  144.   DoCmd.OpenQuery ("ClearExpiredXTables")
  145.   DoCmd.OpenQuery ("CleartblContractsTemp")
  146.  
  147.   DoCmd.SetWarnings True
  148.  
  149. Exit_cmdAddToOutlook_Click:
  150.     Exit Sub
  151.  
  152. Err_cmdAddToOutlook_Click:
  153.     MsgBox Err.Description
  154.     Resume Exit_cmdAddToOutlook_Click
  155.  
  156. End Sub
  157.  
Dec 27 '06 #9

100+
P: 153
oh my...you've gone mad lol Thanks...I think you did a looot more than you needed to. I know I use more code than I need to but I think it's good practice to keep all my options in mind since I am new to this. I will let you know if it works in a little bit.
Dec 27 '06 #10

100+
P: 153
stSQL = "SELECT * FROM AddedToOutlook WHERE DatabaseReferenceNumber = " _
& rsContTemp("DatabaseReferenceNumber2")

rsOutlook.Open stSQL, con, adOpenKeyset, adLockOptimistic
If rsOutlook.EOF Then
rsOutlook.AddNew
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.Start = rsContTemp.Fields("NotificationDate2") _
& " " & rsContTemp.Fields("ApptTime2")
.Duration = 15
.Subject = "Contract Notification/End" & " " _
& rsContTemp.Fields("DatabaseReferenceNumber2") _
& " " & rsContTemp.Fields("Vendor2")
.Body = "Contract Notification/End" & " " _
& rsContTemp.Fields("DatabaseReferenceNumber2") _
& " " & rsContTemp.Fields("Vendor2")
.ReminderMinutesBeforeStart = rsContTemp.Fields("ReminderMinutes2")
.ReminderSet = True
.Save
End With
rsOutlook.Fields("AddedToOutlook") = True
rsOutlook.Fields("DatabaseReferenceNumber") = rsContTemp.Fields("DatabaseReferenceNumber2")
Set outobj = Nothing
'DoCmd.RunCommand acCmdSaveRecord
rsOutlook.Update
End If
rsOutlook.Close
Hey, I'm just trying to figure out what you are doing by opening rsOutlook as stSQL ...I don't see how it knows that rsOutlook is the table "AddedToOutlook" now if you open rsOutlook as stSQL - sorry...again, I'm relatively new so please forgive me :)
Dec 27 '06 #11

100+
P: 1,646
Hey, I'm just trying to figure out what you are doing by opening rsOutlook as stSQL ...I don't see how it knows that rsOutlook is the table "AddedToOutlook" now if you open rsOutlook as stSQL - sorry...again, I'm relatively new so please forgive me :)
"AddedToOutlook" is a string and so is stSQL
Expand|Select|Wrap|Line Numbers
  1. stSQL = "SELECT * FROM AddedToOutlook WHERE DatabaseReferenceNumber = " _
  2. & rsContTemp("DatabaseReferenceNumber2")
I have changed the string to return no records if there is no match
Dec 27 '06 #12

100+
P: 153
yes but I guess what I'm asking is where do you add the contents of that string to AddedToOutlook? because it says rsOutlook.fields("etc..") = etc... but how does that add to AddedToOutlook if you open the connection as stSQL? Is there something I missed?
Dec 27 '06 #13

100+
P: 1,646
yes but I guess what I'm asking is where do you add the contents of that string to AddedToOutlook? because it says rsOutlook.fields("etc..") = etc... but how does that add to AddedToOutlook if you open the connection as stSQL?
You are always using an SQL statement. When you use only the table name, "AddedToOutlook", it is an abbreviation for "SELECT * FROM AddedToOutlook". ADO works this out for you. I have added a WHERE clause to this statement so that we can test for an existing record.

The part of the sql statement, "SELECT *" means that we have all of the fields in the recordset so we can add a new record to this recordset using all or some of the fields. When you ask the recordset to update, it will update the AddedToOutlook table because that is the only table that we have queried here.
Dec 27 '06 #14

100+
P: 153
You are always using an SQL statement. When you use only the table name, "AddedToOutlook", it is an abbreviation for "SELECT * FROM AddedToOutlook". ADO works this out for you. I have added a WHERE clause to this statement so that we can test for an existing record.

The part of the sql statement, "SELECT *" means that we have all of the fields in the recordset so we can add a new record to this recordset using all or some of the fields. When you ask the recordset to update, it will update the AddedToOutlook table because that is the only table that we have queried here.
Ahh...glorious...I understand now. Thank you.
Dec 27 '06 #15

100+
P: 1,646
Ahh...glorious...I understand now. Thank you.
You are very welcome. There are several changes in your code that I implemented for efficiency and readability. It would be useful for you to write code in this style as it will assist you in finding bugs and will make it a lot easier for others to read your code.
Good luck
Dec 27 '06 #16

100+
P: 153
Yes, I learned some new shortcuts from your code. Thank you. As for your code....works like a charm...I ran into some errors, however, since I had changed the numbers over to strings and thought that would make them work better in the string but it actually ended up in a type mismatch....which is good because I could just leave them as numbers and have no problems. If you get a chance, could you explain why that would happen? Do you have to look for strings a different way in the declaration of stSQL if they are strings and not integers? or maybe the error didn't occur there...because it would add the first record and not go onto the next so I guess the error would have had to occur after that?
Dec 27 '06 #17

100+
P: 1,646
Yes, I learned some new shortcuts from your code. Thank you. As for your code....works like a charm...I ran into some errors, however, since I had changed the numbers over to strings and thought that would make them work better in the string but it actually ended up in a type mismatch....which is good because I could just leave them as numbers and have no problems. If you get a chance, could you explain why that would happen? Do you have to look for strings a different way in the declaration of stSQL if they are strings and not integers? or maybe the error didn't occur there...because it would add the first record and not go onto the next so I guess the error would have had to occur after that?
In a sql statement strings must be enclosed in single quotes:

Expand|Select|Wrap|Line Numbers
  1. "SELECT * FROM TableName WHERE [StringField] = '" & MyString & "'"
Dec 27 '06 #18

100+
P: 153
In a sql statement strings must be enclosed in single quotes:

Expand|Select|Wrap|Line Numbers
  1. "SELECT * FROM TableName WHERE [StringField] = '" & MyString & "'"
Ahh i-c. Thanks again :)

Cheers
Kosmös
Dec 27 '06 #19

NeoPa
Expert Mod 15k+
P: 31,186
Nice work Will :)
Dec 30 '06 #20

Post your reply

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