DateSerial overflow with dates greater than 17/09/2059 - vb6

I am currently working on a VB6 project that handles event data transmit by UK rail stock. Occasionally the trains 'gets confused' about the date and will transmit events dated wildly in the future, I have seen events dated as far as 2088. The date is transmit as Unix time (seconds from 1/1/1970).
I understand what the issue is, i am just struggling to find a solution. The issue appears to be when the date exceeds '17/09/2059' it overflows the integer used for the 'day' that DateSerial can handle. The code below is the line where the overflow occurs, so when 'intDays+1' is > 32767.
UnixTimestampToDateTime = DateSerial(1970, 1, intDays + 1) + TimeSerial(intHours, intMins, CInt(intSecs))
The goal is to convert Unix time into the following format "dd/mm/yyyy hh:mm:ss". Can i get DateSerial to work beyond this date limitation or do i need to completely change how i calculate the date? Any help would be appreciated. Cheers.

You could initialize your result to 01/01/1970 and then add the required seconds:
Dim unix_time As Currency
Dim max_long As Long
Dim result As Variant
' Determine unix time
unix_time = .....
' Initialize result to 01/01/1970 00:00:00
result = DateSerial(1970, 1, 1) + TimeSerial(0, 0, 0)
' Determine maximum number of seconds we can add in a single call
max_long = 2147483647
' Add desired time
While unix_time > max_long
result = DateAdd("s", max_long, result)
unix_time = unix_time - max_long
Wend
result = DateAdd("s", CLng(unix_time), result)

Actually it is quite trivial to come up with a replacement version of DateSerial that accepts Long for days, e.g. try this:
Private Function MyDateSerial(ByVal Year As Integer, ByVal Month As Integer, ByVal Day As Long)
MyDateSerial = DateSerial(Year, Month, 1) + Day - 1
End Function
Here is a simple use-case to test it
Debug.Print MyDateSerial(1970, 1, 30000), DateSerial(1970, 1, 30000)
19.2.2052 19.2.2052

Related

VBS Object Required Error manipulating strings

I am trying to create a simple script that prompts the user for their birthday, formatted as 10.02.20, then takes that string and turns it into text, such as October 2nd 2020. I have the following code:
Dim bd, message, title ' define variables
title = "What is your birthday?" ' set variable
message = "Format like so: 12.15.07; 3.03.05" ' set variable
bd = InputBox(message, title) ' prompt user
Dim year
year = bd.Substring(6, 2)
Dim month
month = bd.Substring(0, 2)
Dim day
day = bd.Substring(3, 2)
msgbox bd ' for testing
call msgbox(year + month + day) 'also testing
And I am getting an error after the prompt, ...\Desktop\test.vbs(8, 1) Microsoft VBScript runtime error: Object required: '12.23.03' and I am not sure what it means, Object Required.
Any fixes or suggestions would be very much appreciated.
You cannot use Substring in VBScript. You can use Mid instead:
Dim year
year = Mid(bd, 7, 2)
The first character in a string is at position 1, not 0, so I adjusted your parameter from 6 to 7.
Also, to concatenate strings, although + works, you can also use &:
call msgbox(year & month & day)
You can use this function in vbscript : FormatDateTime(date,format)
Parameter Description
date Required.
Any valid date expression (like Date() or Now())
format Optional.
A value that specifies the date/time format to use can take the following values:
0 = vbGeneralDate - Default. Returns date: mm/dd/yyyy and time if specified: hh:mm:ss PM/AM.
1 = vbLongDate - Returns date: weekday, monthname, year
2 = vbShortDate - Returns date: mm/dd/yyyy
3 = vbLongTime - Returns time: hh:mm:ss PM/AM
4 = vbShortTime - Return time: hh:mm
Dim Title,Input
Title = "format date"
Input = InputBox("Enter your date of Birthday !",Title,"10.02.20")
Input = FormatDateTime(Replace(Input,".","/"),1)
MsgBox Input

How does the DateAdd function in ASP Classic work with the "ww" weeks option?

I have to replicate functionality in C# from an old asp classic codebase.
The codebase seems to assume that the year can have up to 54 weeks and uses the DateAdd method with the "ww" option to figure out the "week ID" for purposes of categorising some files.
All of the online documentation I have found seems to ignore this question and a straightforward reading of it suggests that adding weeks is the same as adding (weeks * 7) days, however, I don't want to break backwards compatibility. I think that the old code has an off by one error but I don't want to assume it. It's possible for a year to have its days in 54 different weeks but I don't think that doing a DateAdd with a value greater than 52 ever makes sense.
My question is, how does the
DateAdd("ww", x, date)
work?
Is it the equivalent of
date.AddDays(7 * x)
in C#?
Are there edge cases where the first of January falls on (for example) a Saturday and DateAdd("ww", 53, date) could return a valid date in the same year?
I can tell you that DateAdd("ww", i, date) is equivalent to DateAdd("d", 7*i, date); therefore, provided that both functions in C# and vbScript have the same meaning, they must be equivalent.
To ensure DateAdd("ww", i, date) is equivalent to DateAdd("d", 7*i, date) I used the script bellow, it cycles 2 years and for each day, it cycles for 104 weeks if adding days or adding weeks mismatch somehow, it raises an error.
date0 = Date()
For i = 0 to 2 * 365
date1 = DateAdd("d", i, date0)
For j = 0 to 2 * 53
date2 = DateAdd("d", j * 7, date1)
date3 = DateAdd("WW", j, date1)
assert = DateDiff("s", date2, date3)
If assert <> 0 Then
errMsg = _
"OPS addDays And addWeeks unmatched" &_
vbCrLf &_
CStr(date1) & vbTab &_
CStr(date2) & vbTab &_
CStr(date3) & vbTab &_
assert & vbTab
Call Err.Raise(vbObjectError + 10, "Test DateAdd(""ww"", i, date)", errMsg)
End If
Next
Next
So I guess you can use date.AddDays(7 * x) to replace DateAdd("ww", x, date) with no concerns in mismatching dates.

VBA written in Excel for Windows not working on Mac

I have a set of macros to hide and unhide columns based on the contents of a specific row. They were all written in Excel 2013 for Windows (running in parallels on my MBA, if that's relevant) and work fine there. But when I open the worksheet in Excel 2011 for Mac, the macros give odd results. The "unhide all columns" macro works fine; the other functions get as far as hiding all columns but not as far as unhiding the ones I want to see.
I can only assume Excel for Mac is having a problem with what's in the FOR EACH loop, but I can't figure out what! I'd appreciate any guidance: I need to get this system working on both Windows and Mac.
Code below.
This function works:
Sub GANTT_Filter_Show_All()
Dim rngDates As Range
Set rngDates = Range("GANTT_Dates")
rngDates.EntireColumn.Hidden = False
End Sub
But this one only hides all the columns:
Sub GANTT_Filter_This_Quarter()
Dim intCurrentMonth As Integer, intCurrentYear As Integer, rngDates As Range, cell As Range
Dim intCurrentQuarterMonths(3) As Integer
Set rngDates = Range("GANTT_Dates")
intCurrentMonth = DatePart("m", Date)
intCurrentYear = DatePart("yyyy", Date)
'loading months of current quarter into an array intCurrentMonth
Select Case intCurrentMonth
Case 1 To 3
intCurrentQuarterMonths(0) = 1
intCurrentQuarterMonths(1) = 2
intCurrentQuarterMonths(2) = 3
Case 4 To 6
intCurrentQuarterMonths(0) = 4
intCurrentQuarterMonths(1) = 5
intCurrentQuarterMonths(2) = 6
Case 7 To 9
intCurrentQuarterMonths(0) = 7
intCurrentQuarterMonths(1) = 8
intCurrentQuarterMonths(2) = 9
Case 10 To 12
intCurrentQuarterMonths(0) = 10
intCurrentQuarterMonths(1) = 11
intCurrentQuarterMonths(2) = 12
End Select
'hiding all columns
rngDates.EntireColumn.Hidden = True
'comparing each column to array of months in current quarter and hiding if false
For Each cell In rngDates
For Each v In intCurrentQuarterMonths
If v = DatePart("m", cell.Value) And DatePart("yyyy", cell.Value) = intCurrentYear Then cell.EntireColumn.Hidden = False
Next v
Next cell
Application.Goto Reference:=Range("a1"), Scroll:=True
End Sub
I'm with #Steven on this one, nothing obviously wrong with the code. I'm not a Mac user, but it's entirely possible that there's some weirdness around the date functions, particularly those that require formatting to resolve.
I would try replacing the calls to DatePart() with calls to Month() and Year() in situations like this - even for non-Mac users. It doesn't rely on parsing the strings for formatting, so it's much more efficient (and easy to read):
Sub Benchmarks()
Dim starting As Double, test As Date, i As Long
test = Now
starting = Timer
For i = 1 To 1000000
Year test
Next i
Debug.Print "Elapsed: " & (Timer - starting)
starting = Timer
For i = 1 To 1000000
DatePart "yyyy", test
Next i
Debug.Print "Elapsed: " & (Timer - starting)
End Sub
Since you likely can't run the benchmark...
Elapsed for Year(): 0.109375
Elapsed for DatePart(): 0.515625
Also note that in addition to this, the dates in the column you're searching are coming through as Variants, it may help to explicitly cast them to dates:
If v = Month(CDate(cell.Value)) And intCurrentYear = Year(CDate(cell.Value)) Then
cell.EntireColumn.Hidden = False
End If

visual basic difference in dates between two lines in text file

I am new to vb express and looking for a way to read two lines in a text file get the difference between then and loop it till the end its a simple clock in clock out system which store each persons clock on and off time in a text file like so
03/11/2014 09:55:02
03/11/2014 14:55:02
03/11/2014 16:55:02
03/11/2014 19:55:02
04/11/2014 09:00:02
04/11/2014 13:00:00
I know I use the DateDiff to get the time but I only want them to work out the difference between line 1 and 2 then 3 and 4 and add them all up is it possible to do that without over complicating things?
I guys I have worked it out I have done this by reading the text filed line by line in a loop at the moment I have not put any validation in to show people who have forgot but the basics are there
Dim FILE_NAME As String = "times\08.txt"
Dim start As DateTime
Dim finish As DateTime
Dim total
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Do While objReader.Peek() <> -1
start = objReader.ReadLine() & vbNewLine
finish = objReader.ReadLine() & vbNewLine
duration = DateDiff(DateInterval.Minute, start, finish)
total = duration + total
Loop
Label2.Text = total

How to find the week number of a given date in Visual Basic 6?

Has anyone a working function that returns the week number of a given date in vb6?
This used to work:
Dim W As Integer
W = Format(DateSerial(2010, 1, 1), "ww", vbMonday, vbFirstFourDays)
But in Windows 8.1 you now get "Out of stack space".
The answer is a bit more complex given the offsets
The following function should work well for what you need. Simply pass it a valid Date object, and it will return an Integer of the Week number.
Private Function Week(dteValue As Date) As Integer
'Monday is set as first day of week
Dim lngDate As Long
Dim intWeek As Integer
'If january 1. is later then thursday, january 1. is not in week 1
If Not Weekday("01/01/" & Year(dteValue), vbMonday) > 4 Then
intWeek = 1
Else
intWeek = 0
End If
'Sets long-value for january 1.
lngDate = CLng(CDate("01/01/" & Year(dteValue)))
'Finds the first monday of year
lngDate = lngDate + (8 - Weekday("01/01/" & Year(dteValue), vbMonday))
'Increases week by week until set date is passed
While Not lngDate > CLng(CDate(dteValue))
intWeek = intWeek + 1
lngDate = lngDate + 7
Wend
'If the date set is not in week 1, this finds latest week previous year
If intWeek = 0 Then
intWeek = Week("31/12/" & Year(dteValue) - 1)
End If
Week = intWeek
End Function
This code is courtesy of FreeVBCode.com (included a reference to give attribute to the original author).

Resources