如何以编程方式计算下一个生日

Question

我有一个包含出生日期列的数据表。

我想将日期分开并将年份部分更改为 today.year，即当前年份。

下面是我的代码：

Dim birthda As New SqlDataAdapter(birthcmd)
Dim birthdt As New DataTable
birthda.Fill(birthdt)

For Each rw As DataRow In birthdt.Rows
    Dim dob As String = rw.Item(3)

    Dim mdat As Date = FormatDateTime(dob, DateFormat.ShortDate)

    Dim bday As Date = (Date.Today.Year & mdat.Month & mdat.Day)

    Dim yers As Integer = DateDiff(DateInterval.Year, mdat.Date, Today.Date)
    Dim moths As Integer = DateDiff(DateInterval.Month, mdat.Date, Today.Date)
    Dim dys As Integer = DateDiff(DateInterval.Day, mdat.Date, Today.Date)

但我收到此错误：

从字符串“2019715”到类型“日期”的转换无效。 说明：执行当前 Web 请求期间发生未处理的异常。请查看堆栈跟踪以获取有关错误及其源自代码的位置的更多信息。

异常详细信息：System.InvalidCastException：从字符串“2019715”到类型“Date”的转换无效。

来源错误：
第 149 行：
第 150 行：Dim bday As Date = (Date.Today.Year & mdat.Month & mdat.Day)

Answer 1

VB.net 在字符串到日期的转换方面非常奇特。

我建议像这样从单个组件转换日期：

Dim bday as Date = New Date(Date.Today.Year, mdat.Month, mdat.Day)

或者如 cmets 中所述尝试使用 VB.Net DateTime

Dim bday as New DateTime(Date.Today.Year, mdat.Month, mdat.Day, 0, 0, 0)

Answer 2

谢谢你，我想我已经知道这就是我所做的。我计算了相对于当年的年龄，并将结果添加到出生日期的年份部分。
这是代码

对于birthdt.Rows中的每个rw作为DataRow

        Dim dob As DateTime = rw.Item(2)


        Dim mdat As Date = FormatDateTime(dob, DateFormat.ShortDate)

     Dim yers As Integer = DateDiff(DateInterval.Year, mdat.Date, Today.Date)
        Dim moths As Integer = DateDiff(DateInterval.Month, mdat.Date, Today.Date)

        Dim dys As Integer = DateDiff(DateInterval.Day, mdat.Date, Today.Date)

        Dim ndob As Date = (DateAdd(DateInterval.Year, yers, mdat))

        Dim yers2 As Integer = DateDiff(DateInterval.Year, ndob.Date, Today.Date)
        Dim moths2 As Integer = DateDiff(DateInterval.Month, ndob.Date, Today.Date)
        Dim dys2 As Integer = DateDiff(DateInterval.Day, ndob.Date, Today.Date)     

Answer 3

我是根据你在comment 中写的：

想要查看某一周即将过生日的人。

处理可能在明年的闰年和日期是很麻烦的，但我想我已经涵盖了所有情况。

我在 SQL Server 中创建了一个表“Pets”，其中包含“Name”和“DOB”列，并放入了一些数据。

我创建了一个新的 Windows 窗体项目并在 Form1 中添加了一个多行文本框，并使用了以下代码：

Imports System.Data.SqlClient
Imports System.Text

Public Class Form1

    Sub ShowUpcomingBirthdays()
        Dim csb As New SqlConnectionStringBuilder With {.DataSource = ".\SQLEXPRESS", .InitialCatalog = "Testing", .IntegratedSecurity = True}

        Dim birthdt As New DataTable()

        Dim sql = "SELECT [Name], [DOB] FROM [Pets]"

        Using conn As New SqlConnection(csb.ConnectionString)
            Using sqlCmd As New SqlCommand(sql, conn)
                Dim da As New SqlDataAdapter With {.SelectCommand = sqlCmd}
                da.Fill(birthdt)
            End Using
        End Using

        Dim matchEarliest = DateTime.Today
        Dim matchLatest = matchEarliest.AddDays(8)

        Dim sb As New StringBuilder ' somewhere to save the matching data

        For Each r As DataRow In birthdt.Rows
            Dim dob = Convert.ToDateTime(r.Item("DOB"))

            ' Allow for leap years by transferring the birthday to 1st March - some countries would use 28th February.
            If DateTime.IsLeapYear(dob.Year) AndAlso Not DateTime.IsLeapYear(matchEarliest.Year) AndAlso dob.Month = 2 AndAlso dob.Day = 29 Then
                dob = dob.AddDays(1)
            End If

            Dim nextBirthday = New DateTime(matchEarliest.Year, dob.Month, dob.Day)

            If dob.Month <= matchEarliest.Month AndAlso dob.Day < matchEarliest.Day Then
                ' birthday has already happened this calendar year, make it next year
                nextBirthday = nextBirthday.AddYears(1)
            End If

            If nextBirthday >= matchEarliest AndAlso nextBirthday < matchLatest Then
                ' the record is in the required range
                sb.AppendLine(CStr(r.Item("Name")) & " " & dob.ToString("ddd dd MMMM"))
            End If

        Next

        TextBox1.Text = sb.ToString()

    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ShowUpcomingBirthdays()

    End Sub

End Class

它包括“今天”发生的生日（你可能不想错过），但你可以

        Dim matchEarliest = DateTime.Today.AddDays(1)
        Dim matchLatest = matchEarliest.AddDays(7)

如果你今天不想加入。

Answer 4

我创建了一个名为 Employee 的小类（它位于代码的底部）。这个答案有点类似于@AndrewMorton。我将 Sub 分解成几个功能，可以在不破坏其余部分的情况下对其进行更改。

Private Sub DisplayUpcomingBirthdays()
    Dim lstBirthdays As New List(Of Employee)
    Dim dt = RetrieveBirthdays()
    For Each rw As DataRow In dt.Rows
        Dim CurrentYearBirthday As Date = GetCurrentYearBD(CDate(rw.Item("Birthdate")))
        If IsBDThisWeek(CurrentYearBirthday) Then
            lstBirthdays.Add(New Employee(CurrentYearBirthday, rw.Item("Name").ToString))
        End If
    Next
    Dim SortedList = SortByBirthdays(lstBirthdays)
    ListBox1.DataSource = SortedList
End Sub

Private Function RetrieveBirthdays() As DataTable
    Dim query = "Select Name, Birthdate From Employes;"
    Dim birthdt As New DataTable
    Using cn As New SqlConnection("YourConnectionString")
        Using cmd As New SqlCommand(query, cn)
            cn.Open()
            birthdt.Load(cmd.ExecuteReader)
        End Using
    End Using
    Return birthdt
End Function

Private Function GetCurrentYearBD(BirthDate As Date) As Date
    Dim Day As Integer = BirthDate.Day
    Dim Month As Integer = BirthDate.Month
    Dim Year As Integer = Now.Year
    'Bithday is celebrated on the 28th when it is not a leap year
    If Month = 2 AndAlso Day = 29 AndAlso Not DateTime.IsLeapYear(Year) Then
        Day = 28
    End If
    Return New DateTime(Year, Month, Day)
End Function

Private Function IsBDThisWeek(BD As Date) As Boolean
    Dim Tomorow = Now.AddDays(1)
    Dim WeekFromNow = Now.AddDays(7)
    If BD >= Tomorow AndAlso BD <= WeekFromNow Then
        Return True
    End If
    Return False
End Function

Private Function SortByBirthdays(Employees As List(Of Employee)) As List(Of Employee)
    Dim lst = (From emp In Employees
               Order By emp.Birthdate
               Select emp).ToList
    Return lst
End Function

Public Class Employee
    Public Property Birthdate As Date
    Public Property Name As String

    Public Sub New(BD As Date, eName As String)
        Birthdate = BD
        Name = eName
    End Sub

    Public Overrides Function ToString() As String
        Return $"{Name},  {Birthdate.ToString("MMMM dd")}"
    End Function
End Class