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).
Related
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
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.
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
Scenario: Trying to find out the End Week Number(current year's week number) and Start Week Number using a given period. Suppose PeriodWeeks = 10. That means from today's week number to last 10 weeks which surely will go to last year in current situation.
Code I have:
perdiodWeeks = 10 ' this is a constant in the code
periodMonths= periodQtrs * 3 ' this calculates month from given number of quarters
endDate = DateAdd("m",-1,Date)
endYear = DatePart("yyyy", endDate)
endMonth = DatePart("m", endDate)
startDate = DateAdd("m", -(periodMonths-1), endDate)
startYear = DatePart("yyyy", startDate)
startMonth = DatePart("m", startDate)
How can I calculate the following?
startYW ' start year week number
endYW ' end year week number
where value would be endYW = 201506 and startYW = perdiodWeeks from endYW. 06 is the current Week Number of 2015
Calculate the initial date (substract #weeks*7) and use the available functions to retrieve the required information
Option Explicit
Dim periodWeeks
periodWeeks = 10
Dim dateToday, dateStart
dateToday = Now()
dateStart = DateAdd("d",periodWeeks*-7, dateToday)
Dim weekToday, weekStart
weekToday = DatePart("ww",dateToday)
weekStart = DatePart("ww",dateStart)
I am currently working on defining workflow scripts in HP Application Lifecycle management tool using VB Script.
My problem is I have to generate an Excel chart for calculating the efforts put on by various developers in a particular Sprint(timeframe). In process of generating the same my condition is to eliminate the weekend dates(ie., Saturday and Sunday) from the chart. If the Sprint startdate falls on a weekend the date shoud automatically be initialized to the next immediate monday and if the Sprint End date falls on a weekend the end date should be displayed as the Friday that just passed. I have validated these two conditions. I am trying to shave off the Saturday and Sundays that come inbetween these two days. Please help me on the same. Also please let me know if you need any inputs from my side.
#Sabaresh, I believe this is what you are looking for.
Tip: See this answer for information on downloading Microsoft's authoritative WSH reference as a Windows help file.
Option Explicit
Dim dCandidateDate, dActualStartDate, dActualEndDate
dCandidateDate = CDate("2012/08/18")
dActualStartDate = SprintStartDate(dCandidateDate)
dCandidateDate = CDate("2012/09/16")
dActualEndDate = SprintEndDate(dCandidateDate)
WScript.Echo "Sprint date range: " _
& dActualStartDate & " through " & dActualEndDate
'
' Return following Monday if dCandidateDate is
' Saturday or Sunday.
'
Function SprintStartDate(dCandidateDate)
Dim nWeekday : nWeekday = DatePart("w", dCandidateDate)
Select Case nWeekday
Case 7 ' Saturday
SprintStartDate = DateAdd("d", 2, dCandidateDate)
Case 1 ' Sunday
SprintStartDate = DateAdd("d", 1, dCandidateDate)
Case Else
SprintStartDate = dCandidateDate
End Select
End Function
'
' Return previous Friday if dCandidateDate is
' Saturday or Sunday.
'
Function SprintEndDate(dCandidateDate)
Dim nWeekday : nWeekday = DatePart("w", dCandidateDate)
Select Case nWeekday
Case 7 ' Saturday
SprintEndDate = DateAdd("d", -1, dCandidateDate)
Case 1 ' Sunday
SprintEndDate = DateAdd("d", -2, dCandidateDate)
Case Else
SprintEndDate = dCandidateDate
End Select
End Function