VB6 - A function for obtaining the Day of the Week given the Date-VBForums
Results 1 to 4 of 4

Thread: VB6 - A function for obtaining the Day of the Week given the Date

  1. #1

    Thread Starter
    Member Senacharim's Avatar
    Join Date
    Feb 2008
    Posts
    56

    VB6 - A function for obtaining the Day of the Week given the Date

    Alright, actually it's two functions; DayOfTheWeek_S and DayOfTheWeek_I.
    DayOfTheWeek_S returns a string value with the day of the week, and DayOfTheWeek_I returns an integer value (0 to 6) of the same.

    Perfect for a module....

    Code:
    Option Explicit
    
    Dim intYr As Integer
    Dim intMo As Integer
    Dim intDay As Integer
    
    Public Function DayOfTheWeek_S(ByVal TheDate As Date) As String
     Select Case DayOfTheWeek_I(TheDate)
      Case 0
       DayOfTheWeek_S = "Sunday"
      Case 1
       DayOfTheWeek_S = "Monday"
      Case 2
       DayOfTheWeek_S = "Tuesday"
      Case 3
       DayOfTheWeek_S = "Wednesday"
      Case 4
       DayOfTheWeek_S = "Thursday"
      Case 5
       DayOfTheWeek_S = "Friday"
      Case 6
       DayOfTheWeek_S = "Saturday"
      Case Else
       DayOfTheWeek_S = "HOLY ****!"
     End Select
    End Function
    
    Public Function DayOfTheWeek_I(TheDate As Date) As Integer
     intYr = Year(TheDate)
     intMo = Month(TheDate)
     intDay = Day(TheDate)
    
     'Debug.Print intYr; "intYr"
     'Debug.Print intMo; "intMo"
     'Debug.Print intDay; "intDay"
    ' W = D + Y + Year + M + C
    ' |   |   |     |    |   ^Century Offset Number (see Century_Offset Function)
    ' |   |   |     |    Month Offset Number (see MonthOffset Function)
    ' |   |   |     Present Year sans Century (i.e. if it's 2008, this number would be "8")
    ' |   |  'YearOffset...
    ' |   Day of the Month (i.e. if the Date is Janueary 1st, this number would be a "1")
    ' Day of the Week! (More or less;)
                              
     DayOfTheWeek_I = intDay + YearOffset + IntYear + MonthOffset + CenturyOffset
     DayOfTheWeek_I = DayOfTheWeek_I Mod 7
    End Function
    
    Private Function MonthOffset() As Integer
     Select Case intMo
      Case 1
       MonthOffset = 0
       If LeapYear = True Then MonthOffset = 6
      Case 2
       MonthOffset = 3
       If LeapYear = True Then MonthOffset = MonthOffset - 1
      Case 3
       MonthOffset = 3
      Case 4
       MonthOffset = 6
      Case 5
       MonthOffset = 1
      Case 6
       MonthOffset = 4
      Case 7
       MonthOffset = 6
      Case 8
       MonthOffset = 2
      Case 9
       MonthOffset = 5
      Case 10
       MonthOffset = 0
      Case 11
       MonthOffset = 3
      Case 12
       MonthOffset = 5
     End Select
     'Debug.Print MonthOffset; "MonthOffset"
    End Function
    
    Private Function LeapYear() As Boolean
     If IntYear = 0 Then 'Century!
      If Century / 400 = Century \ 400 Then LeapYear = True
      If Century / 4000 = Century \ 4000 Then LeapYear = False
     Else 'not round century...
      If (Century Mod 4) = 0 Then LeapYear = True
     End If
     'Debug.Print LeapYear; "LeapYear"
    End Function
    
    Private Function IntYear() As Integer
     IntYear = intYr - (IntCentury * 100)
     'Debug.Print IntYear; "IntYear"
    End Function
    
    Private Function IntCentury() As Integer
     IntCentury = intYr \ 100
     'Debug.Print IntCentury; "IntCentury"
    End Function
    
    Private Function CenturyOffset() As Integer
     CenturyOffset = 2 * (3 - (IntCentury Mod 4))
     'Debug.Print CenturyOffset; "CenturyOffset"
    End Function
    
    Private Function YearOffset() As Integer
     YearOffset = IntYear \ 4
     'Debug.Print YearOffset; "YearOffset"
    End Function
    I'm sure this could be optimized, I only needed it to work.
    I've gotten alot from this forum, glad nobody's posted this yet so I can give a little back.
    _____________________________
    . Error Code 34: There is no error .

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    37,191

    Re: VB6 - A function for obtaining the Day of the Week given the Date

    Thanks for sharing

    That can actually be simplified quite a bit by making use of the Format function, which provides lots of functionality for converting Dates etc:
    Code:
    Public Function DayOfTheWeek_S(ByVal TheDate As Date) As String
      DayOfTheWeek_S = Format(TheDate, "dddd")
    End Function
    
    Public Function DayOfTheWeek_I(TheDate As Date) As Integer
      DayOfTheWeek_I = Format(TheDate, "w") - 1
    End Function
    (I added the -1 because the format function returns "1 for Sunday through 7 for Saturday", which is 1 higher than you wanted).

  3. #3
    Super Moderator Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,335

    Re: VB6 - A function for obtaining the Day of the Week given the Date

    I echo si_the_geek's comments. Thanks for sharing.

    The leap year testing could also be optimized a bit by using the DateSerial function
    vb Code:
    1. Private Function IsThisALeapYear(ByVal intYear As Integer) As Boolean
    2.      IsThisALeapYear = (29 = Day(DateSerial(intYear, 2, 29)))
    3. End Function
    Please use [Code]your code goes in here[/Code] tags when posting code.
    When you have received an answer to your question, please mark it as resolved using the Thread Tools menu.
    Before posting your question, did you look here?
    Got a question on Linux? Visit our Linux sister site.
    I dont answer coding questions via PM or EMail. Please post a thread in the appropriate forum section.

    Creating A Wizard In VB.NET
    Paging A Recordset
    What is wrong with using On Error Resume Next
    Good Article: Language Enhancements In Visual Basic 2010
    Upgrading VB6 Code To VB.NET
    Microsoft MVP 2005/2006/2007/2008/2009/2010/2011/2012/Defrocked

  4. #4

    Thread Starter
    Member Senacharim's Avatar
    Join Date
    Feb 2008
    Posts
    56

    Re: VB6 - A function for obtaining the Day of the Week given the Date

    Ah, gone and re-coded the wheel, have I?

    Well, live and learn. Thanks for the instructional words of wisdom.
    _____________________________
    . Error Code 34: There is no error .

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.