Complicated Time Checking in VBA

[erickat]

Problem Statement: Approved code deployment windows are 1) Overnight (10 pm – 6 am EST) 2) Lunch (12 pm – 1:30 pm EST) 3) Evening (5 pm – 6 pm EST) - but people don't follow the rules. I get automated emails whose 1st line contains deployment results

e.g.
CMD_START: WS restart on ea_awd_services in AWD for UNIX_WAS7_DEV_RPSI_1 at Mon Jul 24 16:03:08 EDT 2017 on pideploy11

and I extract the data as follows:

Mnemonic = AWD
Environment = DEV
Domain = RPSI
Date = Jul 24 16:03:08 EDT 2017 (4:03 pm)

There are hundreds of these emails - and I have a macro that reads the 1st line & extracts the information (from outlook) and writes it to Excel.
However - the code I have that should check to see if the deployment time falls within a valid deployment window or not does not work.
Note - DispTime contains only time values e.g. "11:18:00 PM"

My thought process was as follows:
1. Turn flag on (flag means it's outside an approved deployment window)
2. Check the first approved window - if the deployment is within this timeframe, turn the flag off.
3. Check the other deployment windows ONLY if the flag is still on.

'------- code to check valid deployment windows (DispTime is the time only element extracted from the 1st line in the email)
Note - there is a different approach I tried (using the #time values# - but that didn't work either, so I commented them out.

DispTime = Format(sRelease_Time, "Medium Time")
Overnight_Start = Format("10:00 PM", "Medium Time")
Overnight_End = Format("6:00 AM", "Medium Time")

sFlag = "Y"
'Overnight Window Check
If DispTime > Overnight_Start And DispTime < Overnight_End Then
'If DispTime >= #10:00:00 PM# And DispTime <= #6:00:00 AM# Then
'we're OK for the overnigh window
sFlag = ""
End If


Lunch_Start = Format("12:00 PM", "Medium Time")
Lunch_End = Format("1:30 PM", "Medium Time")

'Only do the next two checks if the flag is still set to "Y"
'Lunch Check
If sFlag = "Y" Then
If DispTime > Lunch_Start And DispTime < Lunch_End Then
'If TimeValue(sRelease_Time) >= TimeValue("12:00:00 PM") And TimeValue(sRelease_Time) <= TimeValue("01:30:00 PM") Then
'we're OK for the overnigh window
sFlag = ""
End If
End If


Evening_Start = Format("5:00 PM", "Medium Time")
Evening_End = Format("6:00 PM", "Medium Time")


'Evening Check
If sFlag = "Y" Then
If DispTime > Evening_Start And DispTime < Evening_End Then
'If TimeValue(sRelease_Time) >= TimeValue("05:00:00 PM") And TimeValue(sRelease_Time) <= TimeValue("06:00:00 PM") Then
'we're OK for the overnigh window
sFlag = ""
End If
End If


Sample output in Excel is as follows:

Mnemonic	Environment	Domain	Release Time	Flag?
CMR	QUAL	RPS-E	11:18 PM	Y

<tbody>
</tbody>

However - you can see this is wrong - 11:18 PM is within the valid overnight deployment window of 10 pm to 6 am - and it should NOT be flagged "y" (flag = Y means it's violated the rules of deploying only during normal deployment windows). Note 2 - no, we can't physically restrict them from deploying - it's a political thing.

 

[erickat]

So, it dawned on me that I could extract the entire date/time string - but it's in a "log" format - so now, sRelease_Time contains a string like this... "Mon Jul 24 16:03:08 EDT 2017" - is that easily converted to a format that vba can compare with standard times, or do I need to jump through hoops to manipulate the string into something more conventional? Note - I'd still like to get the original issue resolved - but I fear it may have to do with the fact that I'm only dealing with time - and Excel needs time and date to deal with time.

 

[erickat]

'so now, sRelease_Time contains a string like this... Mon Jul 24 16:03:08 EDT 2017
'Heres a quick & dirty conversionto a standard date format
'(we know all the dates are july, so just hard code for now)
Dim a() As String
Dim intCount As Integer

a = Split(sRelease_Time, " ")

sNewTime = "7/" & a(2) & "/" & a(5) & " " & a(3)
'This gives us a value of 7/25/17 11:18 PM

'I think the challenge now is in formatting the compare times
DispTime = TimeValue(sRelease_Time) 'This gives a time of 11:18 PM
Overnight_Start = Format("10:00 PM", "Medium Time")
Overnight_End = Format("6:00 AM", "Medium Time")

If DispTime > Overnight_Start And DispTime < Overnight_End Then ...

I think I'm close - but can't get the compare to work correctly.
11:18 PM is greater than 10:00 PM and less than 6:00 AM - but VBA won't honor it.
Obviously, VBA does not think my values are what I see in the display (immediate window or msgbox)

What do I need to do to make this checking of time against the valid deployment windows work?

Thanks in advance - this is driving me crazy - and I've tried many different approaches - but none seem to work.

 

[Engineer Joe]

Are you sure that all of your code is looking at time of day only and that none of them are looking at Date? e.g. can you convert each variable to see it as a number instead of a time?

 

[erickat]

?TimeValue(DispTime)
11:18:00 PM
?TimeValue(Overnight_Start)
10:00:00 PM
?TimeValue(Overnight_End)
6:00:00 AM

Note - I just changed the code to this... 'If (TimeValue(DispTime) > TimeValue(Overnight_Start)) And (TimeValue(DispTime) < TimeValue(Overnight_End)) Then but it still does not work

 

[JoeMo]

?TimeValue(DispTime)
11:18:00 PM
?TimeValue(Overnight_Start)
10:00:00 PM
?TimeValue(Overnight_End)
6:00:00 AM

Note - I just changed the code to this... 'If (TimeValue(DispTime) > TimeValue(Overnight_Start)) And (TimeValue(DispTime) < TimeValue(Overnight_End)) Then but it still does not work

Your problem is that 11:18 PM is not less than 6:00 AM on the same day. Excel measures time in fractions of a day. So 6:00 AM is 0.25 days and 11:18 PM is 0.97 days. You really want to compare the latter value to 1.25 days b/c 6:00 AM is on the next day. Try this:

If (TimeValue(Overnight_End) - (TimeValue(DispTime)) mod 1 > TimeValue(Overnight_End) Then
        TimeValue(Overnight_End) = 1+ TimeValue(Overnight_End)
End if
If (TimeValue(DispTime) > TimeValue(Overnight_Start)) And (TimeValue(DispTime) < TimeValue(Overnight_End)) Then
'.......

EDIT: See change in red font.

 

[erickat]

?(TimeValue(Overnight_End) - TimeValue(DispTime)) Mod 1
0

It didn't honor the new code... did I mess it up? when I pasted it in, it was red - had to adjust the parens

sFlag = "Y"
'Overnight Window Check
If (TimeValue(Overnight_End) - TimeValue(DispTime)) Mod 1 > 0 Then
TimeValue(Overnight_End) = 1 + TimeValue(Overnight_End)
End If

If (TimeValue(DispTime) > TimeValue(Overnight_Start)) And (TimeValue(DispTime) < TimeValue(Overnight_End)) Then
'we're OK for the overnigh window
sFlag = ""
End If

 

[JoeMo]

I edited post #6, apparently after you read post #6. Try this:

If (TimeValue(Overnight_End) - TimeValue(DispTime)) Mod 1 > TimeValue(Overnight_End) Then
        TimeValue(Overnight_End) = 1 + TimeValue(Overnight_End)
End If

 

[erickat]

Thank-you JoeMo for pointing out what I should have seen all along - you can't just look at 10 pm and 6 am - 6 am is a different day.
Since I'm looping through a list of emails that have accumulated over time, the date-time values for each valid deployment window must change for every email.
e.g. if the first email is for a deployment that finished on 7/25/17 at 5 pm - then the time gates for the period must reference 7/25 - but the next one may be 7/26 or 7/28 etc...

Here's how I finally resolved it (Note - there are some shortcuts here that I'll need to fix up when I get time - e.g. hardcoding "7" for July - all the releases now are in July (until we get to August))
I'll fix that later, now that the code is working. It's actually quite simple - just take the full date & add the time (and add a day for 6 am the next morning)

'string we're parsing = QUAL_RPSE_2 at Thu Jul 27 09:39:30 EDT 2017 on pideploy11
'Release Time - look backwards from end to find " at " -then add 4 to get to the start of the date string
' - look backwards from end to find " on "
' now you need to subtract them to get the length
iStart = InStrRev(sFull_String, " at ", -1)
iStart = iStart + 4
iEnd = InStrRev(sFull_String, " on ", -1)
iLen = iEnd - iStart
' iStart = InStr(1, sFull_String, sEDT, 1) - 8
sRelease_Time = Mid(sFull_String, iStart, iLen)
'so now, sRelease_Time contains a string like this... Mon Jul 24 16:03:08 EDT 2017
Dim a() As String
Dim intCount As Integer

a = Split(sRelease_Time, " ") 'the split command parses the string into an array, the elements separated (in my case) by spaces - but you could specify any character

sHour = Mid(a(3), 1, 2)

If sHour > 11 Then
DispTime = "7/" & a(2) & "/" & a(5) & " " & a(3) & " PM"
Else
DispTime = "7/" & a(2) & "/" & a(5) & " " & a(3) & " AM"
End If

sOvernight_Start = "7/" & a(2) & "/" & a(5) & " " & "10:00:00 PM"
'Note - because the end hour is in the next day, we add an hour to the day here
sOvernight_End = "7/" & a(2) + 1 & "/" & a(5) & " " & "06:00:00 AM"

sLunch_Start = "7/" & a(2) & "/" & a(5) & " " & "12:00 PM"
sLunch_End = "7/" & a(2) & "/" & a(5) & " " & "1:30 PM"

sEvening_Start = "7/" & a(2) & "/" & a(5) & " " & "5:00 PM"
sEvening_End = "7/" & a(2) & "/" & a(5) & " " & "6:00 PM"

'Note - we have 3 distinct windows here - one may be OK and the rest not, or they may all be missed.
sFlag = "Y"
'Overnight Window Check
If (DispTime > sOvernight_Start) And (DispTime < sOvernight_End) Then
'we're OK for the overnigh window - turn the flag off
sFlag = ""
End If

'Only do the next two checks if the flag is still set to "Y"
'Lunch Check
If sFlag = "Y" Then
If (DispTime > sLunch_Start) And (DispTime < sLunch_End) Then
'we're OK for the Lunch window
sFlag = ""
End If
End If


'Evening Check
If sFlag = "Y" Then
If (DispTime > sEvening_Start) And (DispTime < sEvening_End) Then
'we're OK for the Evening window
sFlag = ""
End If
End If

Note - this is resolved, but I don't see where the "resolved" checkbox is

 

[erickat]

Here's the completed macro - working great now that I used Cdate to convert the string values to actual dates.

Code
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim t() As String
Dim a() As String
Dim iCount As Integer
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.mailItem
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF As String

Dim sCol, sFull_String, sMnemonic, sEnvironment, sDomain, sRelease_Time, sFlag, sMsg As String
Dim bDebug As Boolean
' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
' Set the path of the workbook
strPath = enviro & "\Documents\test.xlsx"

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")

On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1
' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection

bDebug = True
iCount = 1

' Email processing loop
For Each obj In Selection
Set olItem = obj
'Grab the first line of the email
sFull_String = LTrim(RTrim(Mid(olItem.Body, 1, 135)))

'strings to look for CMD_START: pideploy11
' tmpStr = Mid(olItem.Body, 2, 140)
' s = InStr(1, tmpStr, "CMD_START:", vbTextCompare)
' sFull_String = Mid(tmpStr, s)

'explore later trying to find the crlf in the string & cut it off before that
'tmpStr = Mid(olItem.Body, 1, 140)
'i = InStr(1, tmpStr, "pideploy", vbBinaryCompare)
'sFull_String = Mid(tmpStr, 1, i)

'OK -here's where we want to do the split command.
'below you can see what index references we want out of the array

t = Split(sFull_String)
' t = Split(Mid(olItem.Body, 1, 135), " ", , vbTextCompare)


'debugging code
' iCount = iCount + 1
' If iCount = 3 Then
' If bDebug = True Then
' bDebug = False
' For x = 0 To UBound(t)
' MsgBox "Array Item # " & x & " = " & t(x)
' Next
' End If
' End If
'debugging code

'we want 6(Nmeonic), 8(environment, 11(month), 12(day), 13(time), and 15(year)
'6 EWF
sMnemonic = t(6)
'8 UNIX_WAS7_DEV_RPSI_1 'note - we get environment and domain from this string
a = Split(t(8), "_")
sEnvironment = a(2)
sDomain = Mid(a(3), 1, 3) & "-" & Mid(a(3), 4, 1)

'11 Jul
sMo = ""
'This works because it's July - don't forget to finish coding this case statement
Select Case t(11)
Case "Jul"
sMo = 7
End Select

'12 26
sDay = LTrim(RTrim(t(12)))

'13 14:34:34
sTime = LTrim(RTrim(t(13)))

sHour = Mid(sTime, 1, 2)
If sHour > 11 Then
M = "PM"
Else
M = "AM"
End If
'15 2017
sYR = LTrim(RTrim(t(15)))

DispTime = CDate(sMo & "/" & sDay & "/" & sYR & " " & sTime & " " & M)

' MsgBox DispTime

sOvernight_Start = CDate(sMo & "/" & sDay & "/" & sYR & " 10:00:00 PM")
'Note - because the end hour is in the next day, we add an hour to the day here
sOvernight_End = CDate(sMo & "/" & sDay + 1 & "/" & sYR & " 06:00:00 AM")

sLunch_Start = CDate(sMo & "/" & sDay & "/" & sYR & " 12:00 PM")
sLunch_End = CDate(sMo & "/" & sDay & "/" & sYR & " 1:30 PM")

sEvening_Start = CDate(sMo & "/" & sDay & "/" & sYR & " 05:00 PM")
sEvening_End = CDate(sMo & "/" & sDay & "/" & sYR & " 06:00 PM")

'Note - we have 3 distinct windows here - one may be OK and the rest not, or they may all be missed.
sFlag = "Y"
'Overnight Window Check
If (DispTime > sOvernight_Start) And (DispTime < sOvernight_End) Then
'we're OK for the overnigh window
sFlag = ""
End If

'Only do the next two checks if the flag is still set to "Y"
'Lunch Check
If sFlag = "Y" Then
If (DispTime > sLunch_Start) And (DispTime < sLunch_End) Then
'we're OK for the Lunch window
sFlag = ""
End If
End If


'Evening Check
If sFlag = "Y" Then
If (DispTime > sEvening_Start) And (DispTime < sEvening_End) Then
'we're OK for the Evening window
sFlag = ""
End If
End If

'write them in the excel sheet
xlSheet.Range("a" & rCount) = sMnemonic
xlSheet.Range("b" & rCount) = sEnvironment
xlSheet.Range("c" & rCount) = sDomain
xlSheet.Range("d" & rCount) = sMo & "/" & sDay & "/" & sYR
' xlSheet.Range("e" & rCount) = FormatDateTime(sMo & "/" & sDay & "/" & sYR & LTrim(RTrim(sTime)))
xlSheet.Range("e" & rCount) = DispTime
xlSheet.Range("f" & rCount) = sFlag
xlSheet.Range("g" & rCount) = sFull_String
'Next row
rCount = rCount + 1
Erase t
Erase a

Next
xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If

Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
MsgBox "all done"
End Sub
/Code