My code is as follows:
Private Sub tbRcvrDepartTime_textchanged(sender As Object, e As EventArgs) Handles tbRcvrDepartTime.TextChanged
'Converts the 90 Receiver Arrival & Departures Date & Times to a string for comparison
Dim raTime As String = tbRcvrArriveTime.Text 'Takes the Time only String and converts to string
Dim raDate As String = dpRcvrArriveDate.Text 'Takes the DateTimePicker and converts date to string
Dim raDateString = String.Concat(raDate, " ", raTime) 'Puts together the Date & Time into one continuous string
'Dim raDateFormat As String = "MM-dd-yyyy HH:mm" 'Sets the String to Date style Format
Dim raResultDate As Date = CDate(raDateString) 'Finalizes the String for use in below comparison
Dim rdTime As String = tbRcvrDepartTime.Text 'Takes the Time only String and converts to string
Dim rdDate As String = dpRcvrDepartDate.Text 'Takes the DateTimePicker and converts date to string
Dim rdDateString = String.Concat(rdDate, " ", rdTime) 'Puts together the Date & Time into one continuous string
'Dim rdDateFormat As String = "MM-dd-yyyy HH:mm" 'Sets the String to Date Format
Dim rdResultDate As Date = CDate(rdDateString) 'Finalizes the String for use in below comparison
'Checks to see if 2 or more hours have elapsed since Receiver Arrival/Departure Date & Time
Dim elapsedR As TimeSpan = rdResultDate.Subtract(raResultDate)
tbRcvrDepartTime.BackColor = If(elapsedR.TotalMinutes > 120, Color.LightPink, Color.White)
End Sub
Both raTime & rdTime are separate textboxes.
Both raDate & rdDate are datetimepickers.
When I run the code "live" initially the first record I look at is displayed correctly. Once I move to another record, this goes out the window... I get random results where it will not change the backcolor to the proper color if >120 minutes has elapsed. Other times it changes the backcolor when there is <120 minutes elapsed. Sometimes no change in backcolor when it should or it will change color when it should not. I attempted to originally do this using TotalHours but met with the same results. It is random and is not consistent. I have worked on this for 2 days now with no difference in results. My thinking is there needs to be a way to "refresh" the rdResultDate & raResultDate info when each new record is loaded but I am unable to do that with my code knowledge.
The code must be able to take into account if a new date is present - ie raDate: 11/01/2016 and raTime: 23:46 and
rdDate: 11/02/2016 and rdTime: 03:00 - this would exceed 2 hours (or 120 minutes) and should read "True" and change the backcolor as it is over 2 hours (or 120 minutes).
However if the following were true:
raDate: 11/01/2016 and raTime: 23:46 and
rdDate: 11/02/2016 and rdTime: 01:00 this would not exceed 2 hours (or 120 minutes) and should read "False" and would not change the backcolor.
All of this code:
Dim Detention90 As String
Try
If elapsedR.TotalMinutes > 120 Then
Detention90 = "True"
Else
Detention90 = "False"
End If
Select Case Detention90.ToString
Case = "True" : tbRcvrDepartTime.BackColor = Color.LightPink
Case Else : tbRcvrDepartTime.BackColor = Color.White
End Select
Catch ex As Exception
'If a problem occurs, show Error message box
MessageBox.Show("Receiver Arrive Time & Depart Time Elapsed error" & vbCrLf & "Lines 1424-1434")
End Try
condenses down to just this:
Dim elapsedR As TimeSpan = rdResultDate.Subtract(raResultDate)
tbRcvrDepartTime.BackColor = If(elapsedR.TotalMinutes > 120, Color.LightPink, Color.White)
Not sure if it will directly address your issue, but it was a bit too much for a comment and I've found compacting code in this way is often extremely beneficial for tracking down difficult bugs.
But in this case, I suspect the main issue is parsing the datetime values... that you're not always parsing the DateTime value you expect from a given input string. Specifically, you have format string variables raDateFormat and rdDateFormat, but then call Date.Parse() such that these format variables are never used, and you are left at the mercy of whatever the default date format is for your thread, process, or system. If you're on a system that uses a d/m/y order as in the UK instead of the US-style m/d/y, you'll end up with some strange results. You probably want DateTime.ParseExact() instead.
Related
I have written a piece of code, that is meant to check if the value entered is a date or not. That part works fine, but when I added what I thought would have been some validation (such as length of the string entered and if the date was before or today) it becomes an infinite loop that I can not escape.
I have tried the code with out the loop, and it behaves as expected, however when I combine the two the infinite loop returns.
'Checks if the value entered is in a 10 digit date format, after today
Do Until IsDate(DateOfJob)
DateOfJob = InputBox("What is the date the work is to be carried out on ? DD/MM/YYYY")
If Len(DateOfJob) <> 10 Then
DateOfJob = "NotEnoughCharacters"
ElseIf DateOfJob <= Date Then
DateOfJob = "Today"
End If
Loop
I would have expected that the code would have entered the loop, collected the value DateOfJob, then run the test to see if it was
Exactly 10 characters long
Before or today's date
At any point, if it did not pass those two tests, the DateOfJob would be give a text value, which would cause the final IsDate test to fail.
However, I feel it is being passed text regardless of what is entered, and therefor failing the test completely.
Thanks in advance for any help.
The length of the input string makes no difference: either you're looking at a date, or you're not: you want the rest of your code to work with the Date value, not the String representation that the user provided.
See if this works for you:
Public Function GetValidDate() As Variant '/Date
Dim isValid As Boolean
Do While Not isValid
Dim userInput As Variant
userInput = VBA.InputBox(...)
' if user cancelled the prompt; we better not prompt again:
If VarType(userInput) = vbBoolean Then
'if we don't assign the result, we yield a Variant/Empty:
Exit Function
End If
If IsDate(userInput) Then
Dim dateValue As Date
dateValue = CDate(userInput) '<~ we know it's valid at this point
isValid = dateValue > VBA.DateTime.Date
End If
Loop
GetValidDate = dateValue
End Function
Use:
'NOTE: As Date would be a *type mismatch* error if GetValidDate is Variant/Empty.
Dim jobStartDate As Variant
jobStartDate = GetValidDate
If Not IsDate(jobStartDate) Then Exit Sub
Don't trap the user into a loop they can't get out of without providing a valid input value - an InputBox has a Cancel button, and the user will expect it to cancel the operation: don't deny them that ability - gracefully handle it instead.
Thanks for everyone's input.
I went with Mathieu Guindon solution in the end, and just modified it slightly.
Nice little bit of code he wrote :)
Do While Not isValid
Dim userInput As Variant
userInput = VBA.InputBox("What is the date the work is to be carried out on ? DD/MM/YYYY")
' if user cancelled the prompt; we better not prompt again:
If VarType(userInput) = vbBoolean Then
'if we don't assign the result, we yield a Variant/Empty:
End
End If
If IsDate(userInput) Then
Dim dateValue As Date
dateValue = CDate(userInput) '<~ we know it's valid at this point
isValid = dateValue > VBA.DateTime.Date
End If
DateOfJob = dateValue
Loop
I am trying to make a small helper app to assist in reading SCCM logs. Parsing the dates has been pretty straightforward until I get to the timezone offset. It is usually in the form of "+???". literal example: "11-01-2016 11:44:25.630+480"
DateTime.parse() handles this well most of the time. But occasionally I run into a time stamp that throws an exception. I cannot figure out why. This is where I need help. See example code below:
Dim dateA As DateTime = Nothing
Dim dateB As DateTime = Nothing
Dim dateStr_A As String = "11-07-2016 16:43:51.541+600"
Dim dateStr_B As String = "11-01-2016 11:44:25.630+480"
dateA = DateTime.Parse(dateStr_A)
dateB = DateTime.Parse(dateStr_B)
MsgBox(dateA.ToString & vbCrLf & dateB.ToString)
IF run it would seem dateStr_B is an invalid time stamp? Why is this? I've tried to figure out how to handle the +480 using the 'zzz' using .ParseExact() format as shown here Date Formatting MSDN
Am I missing something with the timezone offset? I've searched high and low but these SCCM logs seem to use a non standard way of representing the offset. Any insight would be greatly appreciated
The problem is that +480 is indeed an invalid offset. The format of the offset from UTC (as produced when using the "zzz" Custom Format Specifier) is hours and minutes. +600 is 6 hours and 0 minutes ahead of UTC, which is valid. +480 would be 4 hours and 80 minutes ahead of UTC, which is invalid as the number of minutes can't be more than 59.
If you have some external source of date and time strings that uses an offset that is simply a number of minutes (i.e. +600 means 10 hours and +480 means 8 hours), you will need to adjust the offset before using DateTime.Parse or DateTime.ParseExact.
[Edit]
The following function takes a timestamp with a positive or negative offset (of any number of digits) in minutes, and returns a DateTime. It throws an ArgumentException if the timestamp is not in a valid format.
Public Function DateTimeFromSCCM(ByVal ts As String) As DateTime
Dim pos As Integer = ts.LastIndexOfAny({"+"c, "-"c})
If pos < 0 Then Throw New ArgumentException("Timestamp must contain a timezone offset", "ts")
Dim offset As Integer
If Not Integer.TryParse(ts.Substring(pos + 1), offset) Then
Throw New ArgumentException("Timezone offset is not numeric", "ts")
End If
Dim hours As Integer = offset \ 60
Dim minutes As Integer = offset Mod 60
Dim timestamp As String = ts.Substring(0, pos + 1) & hours.ToString & minutes.ToString("00")
Dim result As DateTime
If Not DateTime.TryParse(timestamp, result) Then
Throw New ArgumentException("Invalid timestamp", "ts")
End If
Return result
End Function
Thank you for the insight. I had a feeling I would need to handle this manually. I just wanted to make sure I wasn't missing something simple in the process. My knowledge of the date and time formatting is a bit lacking.
As such, I have altered my code so that it handles the offset. Granted I will have to add some more input validation in the final product.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dateA As DateTime = Nothing
Dim dateB As DateTime = Nothing
Dim dateStr_A As String = correctOffset("11-07-2016 16:43:51.541+600")
Dim dateStr_B As String = correctOffset("11-07-2016 16:43:51.541+480")
dateA = DateTime.Parse(dateStr_A)
dateB = DateTime.Parse(dateStr_B)
MsgBox(dateA.ToString & vbCrLf & dateB.ToString)
End Sub
Public Function correctOffset(ByVal ts As String)
Dim offset As Integer = CInt(ts.Substring(ts.Length - 3))
Dim offHour As Integer = offset / 60
Dim offMin As Integer = offset - (offHour * 60)
Dim strhour As String = Nothing
Dim strmin As String = Nothing
If offHour <= 9 Then
strhour = "0" & CStr(offHour)
Else
strhour = CStr(offHour)
End If
If offMin <= 9 Then
strmin = "0" & CStr(offMin)
Else
strmin = CStr(offMin)
End If
Return ts.Substring(0, ts.Length - 3) & strhour & ":" & strmin
End Function
I have a SELECT that returns a column in datagridview called date and time of datetimepicker and also a column with the flag "input" or "output". I want to return a result with the sum of hours of datetimepicker with the flag "input" and another sum to the flag " ouput ".
Could you help me guys?
Cheers....
But anyway try this to get the sum of time in hours or minutes.
Dim FirstIn As String = CDate(dtp1.value.date).ToString("HH:mm") 'try with or without cdate.
Dim FirstOut As String = CDate(dtp2.value.date).ToString("HH:mm") 'try with or without cdate.
Dim elapsedTime As TimeSpan = DateTime.Parse(FirstOut).Subtract(DateTime.Parse(FirstIn))
Dim elapsedMinutesText As String = elapsedTime.Minutes.ToString()
Dim elapsedHrsText As String = elapsedTime.Hours.ToString * 60
Dim totalMinute As String = CInt(elapsedMinutesText) + CInt(elapsedHrsText)
'then try to isert it to txtbox or message box to see the result.
'but now you can get the minutes and total hours of it.
Hope this it what you want.
Not sure if it is possible but is there a piece of code that states when you enter 2 characters then it jumps past the : or / symbol (one for date & one for time that needs manually entering.
I'm guessing it needs to be in the change event of the textbox but not sure on the type of code for setting focus to 3 digits in once 2 have been entered.
Thanks
Al
Say you have a sample UserForm1 with 2 TextBoxes (TextBox1 for the date, TextBox2 for the time)
You can constantly check the length of the string typed in the textboxes and if it is equal to 8 for the date or 4 for the time you manipulate the value ie.
Private Sub TextBox1_Change()
Dim current As String
current = TextBox1.Value
If Len(TextBox1) = 8 Then
current = Left(TextBox1, 2) & "/" & Mid(TextBox1, 3, 2) & "/" & Right(TextBox1, 4)
TextBox1 = current
End If
End Sub
Private Sub TextBox2_Change()
Dim current As String
current = TextBox2.Value
If Len(TextBox2) = 4 Then
current = Left(TextBox2, 2) & ":" & Right(TextBox2, 2)
TextBox2 = current
End If
End Sub
so now if you start the UserForm1 and type for example 10102014 the code will automatically convert it to a date format adding the forward slashes in between the characters. Same goes for the time
I'm struggling in vein to work out how to remove 5 days from today's date...
I have the following simple code that searches compares the result of a text file array search and then compares them to today's date. If the date within the text file is older than today then it deletes, if not it doesn't.
What i want though is to say if the date in the text file is 5 days or older then delete.
This is being used in the English date format.
Sub KillSuccess()
Dim enUK As New CultureInfo("en-GB")
Dim killdate As String = DateTime.Now.ToString("d", enUK)
For Me.lo = 0 To UBound(textcis)
If textcis(lo).oDte < killdate Then
File.Delete(textcis(lo).oPath & ".txt")
End If
Next
End Sub
Thanks
You can use the AddDays method; in code that would be something like this:
Dim today = DateTime.Now
Dim answer = today.AddDays(-5)
msdn.microsoft.com/en-us/library/system.datetime.adddays.aspx
Which would make your code
Sub KillSuccess()
Dim killdate = DateTime.Now.AddDays(-5)
For Me.lo = 0 To UBound(textcis)
If textcis(lo).oDte < killdate Then
File.Delete(textcis(lo).oPath & ".txt")
End If
Next
End Sub