How to check if an item in a table is between two times M:N - sql

I have a many to many relationship between two entities. Computer and Booking, with the link entity being BookingToComputer which contains bookingID and computerID. Im trying to check that the computer is available for booking before adding it to the tables.
So I've selected the date, time, and hours of use (3 attributes in the booking table) of existing Booking records. I've created two time variable, start time (totalTime) and the end time of a booking (endtime). I've tried to put a loop to where each item in my list would go through all the selected rows from a datagridview to check if they match but I don't think I got it quite right and at this point im super confused.
Dim Part1 As String = txtTime.Text + ":00:00"
Dim Part2 As String = "00:" + txtTime1.Text + ":00"
Dim Part3 As String = "00:00:" + txtTime2.Text
Dim Time1 As TimeSpan = TimeSpan.Parse(Part1)
Dim Time2 As TimeSpan = TimeSpan.Parse(Part2)
Dim Time3 As TimeSpan = TimeSpan.Parse(Part3)
Dim TotalTime As TimeSpan = Time1 + Time2 + Time3
SQL.AddParam("#Time", txtTime.Text & ":" & txtTime1.Text & ":" & txtTime2.Text)
SQL.AddParam("#Date", txtDate.Text)
SQL.ExecQuery("SELECT bc.Computer_ID, hours_of_use, time_of_use FROM BookingToComputer AS bc, Computer AS c, Booking AS b
WHERE bc.Booking_ID = b.Booking_ID AND c.Computer_ID = bc.Computer_ID AND b.date_of_use = #Date AND b.time_of_use <= #Time;")
DataGridView2.DataSource = SQL.DBDT
If DataGridView2.Rows.Count() > 0 Then
'cell1 contains the hours used and time contains the time'
Dim TimeInt As Integer = DataGridView2.Rows(0).Cells(1).Value
Dim TimeInt2 As TimeSpan = DataGridView2.Rows(0).Cells(2).Value
Dim Addit As String = TimeInt.ToString + ":00:00"
Dim interv As TimeSpan = TimeSpan.Parse(Addit)
Dim endtime As TimeSpan = TimeInt2 + interv
Dim rowpass As Integer = 0
For Each x In listpick
Dim CompID As Integer = DataGridView2.Rows(rowpass).Cells(0).Value
If x = CompID Then
If endtime > TotalTime Then
MsgBox(x & " is already reserved.")
Else
MsgBox("diff time, same comp")
End If
Else
MsgBox("Good time - diff comp")
End If
rowpass = rowpass + 1
Next
End If

Related

How to convert Julian date ignoring the year to Julian Day

How do i convert day/Month to Julian Day in visual basic?
Formula for converting in other languages are also appreciated.
For e.g
Julian Day for 1 Feb=032
https://landweb.modaps.eosdis.nasa.gov/browse/calendar.html
From research in the web ,most resolutions are converting the date with yyyy-mm-dd to julian date.
As the example above, i need to get value 032
The .Net JulianCalendar Class exposes all methods needed to achieve your goal. It is also COM visible, so you can reference it in a VBA project after adding a project reference to "mscorlib.dll".
In VB.Net the code would be:
Dim jc As New System.Globalization.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As DateTime = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018 12:00:00 AM#
Dim dayOfYear As Int32 = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
In VBA the code would be:
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
First you have to add reference to mscorlib library
Under VB6,Project-References->Tick the mscorlib checkbox
Create this function method in the object that you ahve or otherwise create a sub procedure
Public Function JulianConverter() As String
'MsgBox Fix(5.2), vbExclamation, App.Title
'MsgBox Fix(5.6)
Dim y As String
Dim m As String
Dim d As String
Dim strDate As String
Dim dateArray() As String
strDate = Format(Now, "dd/MMM/yyyy")
dateArray = Split(strDate, "/")
d = dateArray(0)
m = dateArray(1)
y = dateArray(2)
'Debug
'MsgBox strDate
'Convert to Integer
y = Val(y)
m = Val(m)
d = Val(d)
If m <= 2 Then
y = y - 1
m = m + 12
End If
'Dim A As Double
' Dim B As Double
'Dim JD As Double
' A = CDbl(Fix(y / 100#))
'B = 2 - A + Fix(A / 4)
'JD = Fix(365.25 * (y + 4716)) + Fix(30.6001 * (m + 1)) + d + B - 1524.5
'JulianConverter = CStr(JD) 'Convert to string
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, m, d, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
Dim dayOfYearS As String
Dim digitLength As Integer
Dim Counter As Integer
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
'Have to ensure 3 digits values
dayOfYearS = CStr(dayOfYear)
'Count number of Digits of string
digitLength = Len(dayOfYearS)
MsgBox "DigitLength" & digitLength, vbExclamation, App.Title
'If Digits length smaller than 3,add one 0 in front
If (digitLength < 3) Then
dayOfYearS = "0" & dayOfYearS
End If
JulianConverter = dayOfYearS
End Function
This will ensure the julian day will be 3 digits in value based on the current system date

VB.NET - Given a date, how can I get the date of last four fridays?

Given today's date want to get the date of the each Friday for the last four weeks.
Here is an easy LINQ approach:
Dim today = Date.Today
Dim lastFridays = From d In Enumerable.Range(0, Int32.MaxValue)
Let dt = today.AddDays(-d)
Where dt.DayOfWeek = DayOfWeek.Friday
Select dt
Dim lastFourFridays As Date() = lastFridays.Take(4).ToArray()
Since it's not the most efficient approach, here is a query that is still readable and maintainable but only searches the first friday and then takes only every 7th day:
Dim lastFriday = lastFridays.First() ' reuse of above query '
Dim fridays = From d In Enumerable.Range(0, Int32.MaxValue)
Let dt = lastFriday.AddDays(-d * 7)
Select dt
Dim lastFourFridays As Date() = fridays.Take(4).ToArray()
You may consume this one, which returns a list of such dates and excludes the one if the specifiedDate date is Friday:
Public Shared Function GetLastFourFridays(specifiedDate As DateTime) As List(Of DateTime)
Dim dtm As New List(Of DateTime)()
Dim dt As DateTime = specifiedDate
For i As Integer = 0 To 6
dt = dt.AddDays(-1)
If dt.DayOfWeek = DayOfWeek.Friday Then
dtm.Add(dt)
Exit For
End If
Next
dtm.Add(dt.AddDays(-7))
dtm.Add(dt.AddDays(-14))
dtm.Add(dt.AddDays(-21))
Return dtm
End Function
and the way you use it is:
Dim dtm As List(Of DateTime) = GetLastFourFridays(DateTime.Now)
For Each d As var In dtm
Console.WriteLine(String.Format("Date: {0}, Day: {1}", d.ToString(), [Enum].Parse(GetType(DayOfWeek), d.DayOfWeek.ToString())))
Next
Here is my way:
Function Last4Friday(ByVal StartDate As Date) As array
Dim L4F()
Dim mDate as date = StartDate
For value As Integer = 1 To 7
mDate = mDate.AddDays(-1)
If mDate.DayOfWeek = DayOfWeek.Friday Then
L4F = {mDate, mDate.AddDays(-7), mDate.AddDays(-14), mDate.AddDays(-21)}
exit for
End If
Next
Return L4F
End Function
Edit: If you need to check the inserted date and you want it returned in the array you may simply use:
Dim mDate as date = StartDate.AddDays(1)
instead of
Dim mDate as date = StartDate
Try this. It doesn't use a loop to find the starting Friday.
Dim someDate As DateTime = DateTime.Now
If someDate.DayOfWeek <> DayOfWeek.Friday Then
'do the math to get a Friday
someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)
End If
Dim last4Fridays As New List(Of DateTime) From {someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)}
All of the other suggestions have used a loop to find the starting Friday. If this code is used infrequently then how the starting Friday is determined might not matter.
edit: as function
Function FindLastFourFridays(someDate As DateTime) As List(Of DateTime)
'Find first Friday to include
If someDate.DayOfWeek <> DayOfWeek.Friday Then
someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)
' uncomment these two lines if you do not want initial someDate.DayOfWeek = DayOfWeek.Friday to be included
'Else
' someDate = someDate.AddDays(-7)
End If
'build the return (four fridays)
Dim last4Fridays As New List(Of DateTime) From {someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)}
Return last4Fridays
End Function
This function does not need to be passed a date it picks up today's date and gets the last four Friday's from today. It can be changed around to get any day of the week.
Dim todaysDate As Date = Date.Today
Dim oldDay As Integer
Dim thisWeek As Date
Dim firstWeek As Date
Dim secondWeek As Date
Dim thirdWeek As Date
Dim fourthWeek As Date
'finds the Friday of the end of the current week No mattter what day you are working
Dim daycount As Integer
'use this to check specific dates "Dim datetime As New DateTime(2015, 4, 13)"
oldDay = Weekday(todaysDate)
thisWeek = todaysDate
If oldDay < 6 Then
daycount = 6 - oldDay
thisWeek = thisWeek.AddDays(+daycount)
ElseIf oldDay > 6 Then
daycount = oldDay - 6
thisWeek = thisWeek.AddDays(-daycount)
End If
Dim currentDate As Date = Now
Do While Not currentDate.DayOfWeek = DayOfWeek.Friday
currentDate = currentDate.AddDays(-1)
Loop
fourthWeek = currentDate.AddDays(-21)
thirdWeek = currentDate.AddDays(-14)
secondWeek = currentDate.AddDays(-7)
firstWeek = currentDate

How to merge cells and remove blank spaces in my DataGrid using proper loop

My title is still broad so i'll explain here further.
This is my current output using my code:
.
But I want to make it look like this..
As you can see on the pictures, i want to remove the blank spaces. Because if I selected MORE data, let's say I selected 7 more days, it will go DIAGONALLY not horizontally.
I think I have a problem regarding my loops. Hope you can help me trace because I've been stuck here for a week debugging. (nevermind my long query, i just want to post all my code. I've also added comments for easier debugging.)
Here's my code:
Private Sub LoadDateAndUser()
Dim SqlStr As String = ""
Dim sqlConn As New SqlConnection(DataSource.ConnectionString)
Dim sqlComm As New SqlCommand(SqlStr, sqlConn)
Dim sqlAdapter As New SqlDataAdapter(sqlComm)
Dim o_Dataset As New DataSet()
SqlStr = " SELECT convert(varchar(10), A.TransDate, 101) as TransDate,ADMMED.TransNum, ADMMED.AdministeredDate, D.Dosage [Dosage], ISNULL(C.GenericName, ' ') + ' (' + IsNull(B.ItemName,'') + ' ' + IsNull(B.ItemDesc,'') + ')' [Medication], ADMMED.UserID" & _
" FROM INVENTORY..tbInvStockCard as A" & _
" LEFT OUTER JOIN INVENTORY..tbInvMaster as B On A.ItemID = B.ItemID " & _
" LEFT OUTER JOIN Inventory.dbo.tbForGeneric as C On B.GenericID = C.GenericID" & _
" LEFT OUTER JOIN Station..tbNurse_AdministeredMedicines ADMMED on a.idnum= ADMMED.idnum " & _
" LEFT OUTER JOIN build_file.dbo.tbCoDosage as D on A.DosageID = D.DosageID" & _
" LEFT OUTER JOIN Station.dbo.tbNurseCommunicationFile as E on A.IdNum = E.IDnum and E.ReferenceNum = A.RefNum" & _
" WHERE A.IdNum = '" & Session.Item("IDNum") & "' and ( A.RevenueID = 'PH' or A.RevenueID = 'PC' ) " & _
" AND A.LocationID = '20' and Not IsNull(ADMMED.AdministeredDate, '') = ''" & _
" AND A.RefNum = ADMMED.ReferenceNum and ADMMED.ItemID = A.itemid" & _
" AND (B.ItemClassificationID = '1' or B.ItemClassificationID = '10' or B.ItemClassificationID = '11' or B.ItemClassificationID = '16' or B.ItemClassificationID = '2' or B.ItemClassificationID = '9')" & _
" order by TransDate desc,ADMMED.AdministeredDate desc"
sqlComm.CommandText = SqlStr
sqlAdapter.Fill(o_Dataset, "Table")
Dim o_Row As DataRow
Dim o_AdmDates As New Collection()
Dim s_FormattedLastAdmDate As String = ""
Dim s_FormattedAdmDate As String = ""
Dim o_DerivedTable As New DataTable()
With o_DerivedTable
.Columns.Add("TransDate")
.Columns.Add("Medication")
.Columns.Add("Dosage")
.Columns.Add("TransNum")
End With
'Select all unformatted administered dates from the query
Dim o_UnformattedAdmDates As DataRow() = o_Dataset.Tables(0).Select("", "AdministeredDate Desc")
'Extract distinct administered dates and change its format
For Each o_Row In o_UnformattedAdmDates
s_FormattedAdmDate = Format(CDate(o_Row.Item("AdministeredDate")), KC_Date_Format) 'eg. Jan 01 15
If s_FormattedLastAdmDate <> s_FormattedAdmDate Then
s_FormattedLastAdmDate = s_FormattedAdmDate
o_AdmDates.Add(s_FormattedLastAdmDate) 'add all formatted dates in o_AdmDates
End If
Next
'Add formatted administred dates to derived table
Dim o_Item As String
For Each o_Item In o_AdmDates
o_DerivedTable.Columns.Add(o_Item)
Next
'Loop through the administred date
Dim o_NewRow As DataRow
Dim o_NextRow As DataRow
Dim i_Ctr As Integer
Dim x_isNewRow As Boolean = True
Dim i_MaxRec As Integer
i_MaxRec = o_Dataset.Tables(0).Rows.Count - 1
For i_Ctr = 0 To i_MaxRec
o_Row = o_Dataset.Tables(0).Rows(i_Ctr)
If i_Ctr <> i_MaxRec Then
o_NextRow = o_Dataset.Tables(0).Rows(i_Ctr + 1)
End If
If x_isNewRow Then
o_NewRow = o_DerivedTable.NewRow()
End If
o_NewRow("TransDate") = o_Row("TransDate")
o_NewRow("Medication") = o_Row("Medication")
o_NewRow("Dosage") = o_Row("Dosage")
o_NewRow("TransNum") = o_Row("TransNum")
'Fill approriate result date column based on query
For Each o_Item In o_AdmDates
s_FormattedAdmDate = Format(CDate(o_Row.Item("AdministeredDate")), KC_Date_Format)
Dim AdmTim As DateTime = DateTime.Parse(o_Row("AdministeredDate"))
If s_FormattedAdmDate = o_Item Then
o_NewRow(s_FormattedAdmDate) = AdmTim.ToString("hh:mm tt") + " - " + o_Row("UserID")
End If
Next
If i_Ctr < i_MaxRec _
And Not o_NextRow Is Nothing _
And o_Row("TransDate") = o_NextRow("TransDate") _
And o_Row("Medication") = o_NextRow("Medication") _
And o_Row("Dosage") = o_NextRow("Dosage") _
And o_Row("AdministeredDate") = o_NextRow("AdministeredDate") Then
x_isNewRow = False
Else
o_DerivedTable.Rows.Add(o_NewRow)
x_isNewRow = True
End If
Next
'Bind derived table
dgSheet.DataSource = o_DerivedTable
dgSheet.DataBind()
If o_Dataset.Tables(0).Rows.Count > 0 Then
GroupGridView(dgSheet.Items, 0, 3)
Else
End If
End Sub
I think you must review your programming logic:
After that huge ugly SqlStr : you will have a DataSet, with a Table with all rows mixed !?
Let's try a pseudo-code:
I think is better to create in that DataSet, 2 Tables:<br>
**first** table with: id, DateOrder, Medication, Dosage <br>
and **second** table with: idDate, FirstTable.id, AdministeredDate
after that you know how many ADMMED.AdministeredDate.Count are, because you must know how manny columns you need to add
create a 3-rd table from iteration of first table, nested with second by ID.
Set as Datasource for DataGridView the Third DataTable.
So you have 2 datasets, and generate this one .. one to many ..
.. I have no time now, if you don't get the ideea .. forget it !

datagrid view change color depend of status in winform application

I have a function like this:
Sub KPIColorchange()
'take 80 percenatge
Dim perc80 As Integer = 80
value80 = DefaultKPI * perc80 / 100
Dim carid As String
Dim strr As String = "select t.TBarcode as carid from Khanger_tbl k
inner join transaction_tbl t on k.transactid=t.transactID"
strr = strr + " where tid= " & tid & " and requested=1 and delivered=0 and status=3
and DATEDIFF(n, CAST(paydate AS DATETIME), GETDATE()) >=" & value80 & ""
Dim cmdr As New SqlCommand(strr, con.connect)
dr2 = cmdr.ExecuteReader
While dr2.Read
If dr2("carid") Is DBNull.Value Then
carid = ""
Else
carid = dr2("carid")
End If
Dim cnt As Integer = DGVall.Rows.Count
For i = 0 To cnt - 2
If DGVall.Rows(i).Cells(0).Value.ToString().Equals(carid) Then
DGVall.Rows(i).DefaultCellStyle.BackColor = Color.Fuchsia
End If
Next
End While
dr2.Close()
con.disconnect()
'take 100 percentage
Dim perc100 As Integer = 100
value100 = DefaultKPI * perc100 / 100
Dim str100 As String = "select t.TBarcode as carid from Khanger_tbl k
inner join transaction_tbl t on k.transactid=t.transactID"
str100 = str100 + " where tid= " & tid & " and requested=1 and delivered=0 and status=3 and
DATEDIFF(n, CAST(paydate AS DATETIME), GETDATE()) >=" & value100 & ""
Dim cmd100 As New SqlCommand(str100, con.connect)
dr2 = cmd100.ExecuteReader
While dr2.Read
If dr2("carid") Is DBNull.Value Then
carid = ""
Else
carid = dr2("carid")
End If
Dim cnt As Integer = DGVall.Rows.Count
For i = 0 To cnt - 2
If DGVall.Rows(i).Cells(0).Value.ToString().Equals(carid) Then
DGVall.Rows(i).DefaultCellStyle.BackColor = Color.OrangeRed
End If
Next
End While
dr2.Close()
con.disconnect()
End Sub
I have a grid view ,in that grid view i am loading some Requested carid we already set some time interval to Location.depend on the location time interval i have to change color in grid view
if the car requested time coming 80 percentage of location interval time then i will change to one color .
if the car requested time coming 100 percentage of location interval time then i will change to OrangeRed only this much things i am doing here..normally my datagrid view contains morethan 100 above records. this function i am calling in Timer_tick event in each one minute.
but becouse of this function my system get slow or some time system get hang.how i can optimize this code?
any help is very appreciable in advance

Writing a routine to create sequential records

I would like to write a routine which will allow me to take dated events (records) in a table which span accross a set time frame and in the cases where no event took place for a specific day, an event will be created duplicating the most recent prior record where an event DID take place.
For example: If on September 4 Field 1 = X, Field 2 = Y and Field 3 = Z and then nothing took place until September 8 where Field 1 = Y, Field 2 = Z and Field 3 = X, the routine would create records in the table to account for the 3 days where nothing took place and ultimately return a table looking like:
Sept 4: X - Y - Z
Sept 5: X - Y - Z
Sept 6: X - Y - Z
Sept 7: X - Y - Z
Sept 8: Y - Z - X
Unfortunately, my level of programming knowledge although good, does not allow me to logically conclude a solution in this case. My gut feeling tells me that a loop could be the correct solution here but I still an not sure exactly how. I just need a bit of guidance to get me started.
Here you go.
Sub FillBlanks()
Dim rsEvents As Recordset
Dim EventDate As Date
Dim Fld1 As String
Dim Fld2 As String
Dim Fld3 As String
Dim SQL As String
Set rsEvents = CurrentDb.OpenRecordset("SELECT * FROM tblevents ORDER BY EventDate")
'Save the current date & info
EventDate = rsEvents("EventDate")
Fld1 = rsEvents("Field1")
Fld2 = rsEvents("Field2")
Fld3 = rsEvents("Field3")
rsEvents.MoveNext
On Error Resume Next
Do
' Loop through each blank date
Do While EventDate < rsEvents("EventDate") - 1 'for all dates up to, but not including the next date
EventDate = EventDate + 1 'advance date by 1 day
rsEvents.AddNew
rsEvents("EventDate") = EventDate
rsEvents("Field1") = Fld1
rsEvents("Field2") = Fld2
rsEvents("Field3") = Fld3
rsEvents.Update
Loop
' get new current date & info
EventDate = rsEvents("EventDate")
Fld1 = rsEvents("Field1")
Fld2 = rsEvents("Field2")
Fld3 = rsEvents("Field3")
rsEvents.MoveNext
' new records are placed on the end of the recordset,
' so if we hit on older date, we know it's a recent insert and quit
Loop Until rsEvents.EOF Or EventDate > rsEvents("EventDate")
End Sub
With no details about your specifics (table schema, available language options etc), iI guess that you just need the algorithm to pick up. So here's a quick algorithm with no safeguards.
properdata = "select * from data where eventHasTakenPlace=true";
wrongdata = "select * from data where eventHasTakenPlace=false";
for each wrongRecord in wrongdata {
exampleRecord = select a.value1, a.value2,...,a.date from properdata as a
inner join
(select id,max(date)
from properdata
group by id
having date<wrongRecord.date
) as b
on a.id=b.id
minDate = exampleRecord.date;
maxDate = wrongRecord.date -1day; --use proper date difference function as per your language of choice.
for i=minDate to maxDate step 1day{
dynamicsql="INSERT INTO TABLE X(Value1,Value2....,date) VALUES (exampleRecord.Value1, exampleRecord.Value2,...i);
exec dynamicsql;
}
}
Private Sub Command109_Click()
On Error GoTo errhandler
Dim rsEvents As Recordset
Dim EventDate As Date
Dim ProjID As String
Dim Fld1 As String
Dim Fld2 As String
Dim Fld3 As String
Dim Fld4 As String
Dim Fld5 As String
Dim Fld6 As String
Dim Fld7 As String
Dim Fld8 As String
Dim Fld9 As String
Dim Fld10 As String
Dim Fld11 As String
Dim Fld12 As String
Dim Fld13 As String
Dim Fld14 As String
Dim Fld15 As String
Dim Fld16 As String
Dim Fld17 As String
Dim Fld18 As String
Dim Fld19 As String
Dim Fld20 As String
Dim Fld21 As String
Dim st_sql As String
Dim Sql As String
Me.Refresh
Set rsEvents = CurrentDb.OpenRecordset("SELECT * FROM tblProjectMasterListHistory02 ORDER BY LastUpdateDate")
'Save the current date and info
EventDate = rsEvents("LastUpdateDate")
ProjID = rsEvents("ID Project")
Fld1 = rsEvents("OverallPrincipleStatus1")
Fld2 = rsEvents("OverallPrincipleStatus2")
Fld3 = rsEvents("OverallObjectiveStatus")
Fld4 = rsEvents("OverallObjectiveStatus2")
Fld5 = rsEvents("OverallDependencyStatus1")
Fld6 = rsEvents("OverallDependencyStatus2")
Fld7 = rsEvents("OverallAssumptionsStatus1")
Fld8 = rsEvents("OverallAssumptionsStatus2")
Fld9 = rsEvents("OverallConstraintsStatus1")
Fld10 = rsEvents("OverallConstraintsStatus2")
Fld11 = rsEvents("ObjectivesScope")
Fld12 = rsEvents("ObjectivesResources")
Fld13 = rsEvents("ObjectivesProjectPlan")
Fld14 = rsEvents("ObjectivesEffort")
Fld15 = rsEvents("ObjectivesBenefits")
Fld16 = rsEvents("ObjectivesResourceMobilisation")
Fld17 = rsEvents("ObjectivesMetrics")
Fld18 = rsEvents("OverallRiskStatus1")
Fld19 = rsEvents("OverallRiskStatus2")
Fld20 = rsEvents("GovernanceStatus1")
Fld21 = rsEvents("GovernanceStatus2")
rsEvents.MoveNext
Do
' Loop through each blank date
Do While EventDate < rsEvents("LastUpdateDate") - 1 'for all dates up to, but not including the next date
EventDate = EventDate + 1 'advance date by 1 day
rsEvents.AddNew
rsEvents("LastUpdateDate") = EventDate
rsEvents("ID Project") = ProjID
rsEvents("OverallPrincipleStatus1") = Fld1
rsEvents("OverallPrincipleStatus2") = Fld2
rsEvents("OverallObjectiveStatus") = Fld3
rsEvents("OverallObjectiveStatus2") = Fld4
rsEvents("OverallDependencyStatus1") = Fld5
rsEvents("OverallDependencyStatus2") = Fld6
rsEvents("OverallAssumptionsStatus1") = Fld7
rsEvents("OverallAssumptionsStatus2") = Fld8
rsEvents("OverallConstraintsStatus1") = Fld9
rsEvents("OverallConstraintsStatus2") = Fld10
rsEvents("ObjectivesScope") = Fld11
rsEvents("ObjectivesResources") = Fld12
rsEvents("ObjectivesProjectPlan") = Fld13
rsEvents("ObjectivesEffort") = Fld14
rsEvents("ObjectivesBenefits") = Fld15
rsEvents("ObjectivesResourceMobilisation") = Fld16
rsEvents("ObjectivesMetrics") = Fld17
rsEvents("OverallRiskStatus1") = Fld18
rsEvents("OverallRiskStatus2") = Fld19
rsEvents("GovernanceStatus1") = Fld20
rsEvents("GovernanceStatus2") = Fld21
rsEvents.Update
Loop
' get new current date and info
EventDate = rsEvents("LastUpdateDate")
ProjID = rsEvents("ID Project")
Fld1 = rsEvents("OverallPrincipleStatus1")
Fld2 = rsEvents("OverallPrincipleStatus2")
Fld3 = rsEvents("OverallObjectiveStatus")
Fld4 = rsEvents("OverallObjectiveStatus2")
Fld5 = rsEvents("OverallDependencyStatus1")
Fld6 = rsEvents("OverallDependencyStatus2")
Fld7 = rsEvents("OverallAssumptionsStatus1")
Fld8 = rsEvents("OverallAssumptionsStatus2")
Fld9 = rsEvents("OverallConstraintsStatus1")
Fld10 = rsEvents("OverallConstraintsStatus2")
Fld11 = rsEvents("ObjectivesScope")
Fld12 = rsEvents("ObjectivesResources")
Fld13 = rsEvents("ObjectivesProjectPlan")
Fld14 = rsEvents("ObjectivesEffort")
Fld15 = rsEvents("ObjectivesBenefits")
Fld16 = rsEvents("ObjectivesResourceMobilisation")
Fld17 = rsEvents("ObjectivesMetrics")
Fld18 = rsEvents("OverallRiskStatus1")
Fld19 = rsEvents("OverallRiskStatus2")
Fld20 = rsEvents("GovernanceStatus1")
Fld21 = rsEvents("GovernanceStatus2")
rsEvents.MoveNext
'new records are placed on the end of the recordset
'so if we hit an older date, we know it's a recent insert and quit
Loop Until rsEvents.EOF Or EventDate > rsEvents("LastUpdateDate")
errhandler:
End Sub