使用日期执行 While 循环

Question

我正在用 VBA 编写代码，它可以循环访问日期并将一些数据添加到 Access 中的某些表中。我觉得我已经尝试了所有方法并浏览了网络，但它似乎仍然无法正常工作。我认为我的问题是日期的格式，因为我使用欧洲日期输入，而不是美国输入。我尝试格式化日期，如下面的代码所示。

Dim TODAY as string, TimeReg as string, UserReg as string, Init as string, _ 
SendFrom as string, SendTo as string, DateFrom as Date, DateTo as date, _
Comment as string

'Me.txtDateF.value Input f.ex. = 01-01-2020
'Me.txtDateT.value Input f.ex. = 16-01-2020

'Values'
TODAY = Me.txtDD.Value
TimeReg = Me.txtTime.value
UserReg = Left(Me.txtUser.value, 3)
Init = Me.cmbInit.value
If IsNull(Me.txtFrom.value) Then
SendFrom = ""
Else
SendFrom = Me.txtFra.value
End if

SendTo = Me.cmbTo.Column(1)
DateFrom = CDate(Format(Me.txtDateF.value, "dd-mm-yyyy"))
DateTo = CDate(Format(Me.txtDateT.value, "dd-mm-yyyy"))
Comment = Me.txtComment.value

'Define team on which it will use in SQL-Query
Select Case Me.txtTeam.value
Case "Team 1"
Team = "Team1"
TeamCom = "Team1Com"
Case "Team 2" etc...
End select

DoCmd.SetWarnings False

Do While DateFrom < DateTo

strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = #" & DateFrom "#"

DoCmd.RunSQL strSQL

ChangeSQL = "INSERT INTO tblChanges " _
& "(Date, Time, InitChange, TimeR, ShiftB, ShiftA, DateR, DateT, Comment)" _
& "VALUES (#" & TODAY & "#, #" & TimeReg & "#, '" & Init & "', '" & UserReg & "', '" & SendFrom & "', '" & SendTo & "', #" & DateFrom "# '" & Comment & "');"

DoCmd.RunSQL ChangeSQL

DateFrom = DateAdd("d", 1, DateFrom)
Loop

DoCmd.SetWarnings True

如果输入日期来自 f.ex。 2020 年 1 月 1 日至 2020 年 1 月 24 日，以下日期有所变化。

• 01-01-2020
• 13-01-2020
• 14-01-2020
• 15-01-2020
• 16-01-2020
• 17-01-2020
• 18-01-2020
• 19-01-2020
• 20-01-2020
• 21-01-2020
• 22-01-2020
• 23-01-2020
• 24-01-2020
• 01-02-2020
• 01-03-2020

缺少 01-01-2020 到 12-01-2020 之间的日期。在我看来，格式已关闭。

Answer 1

这里有很多错误，但这应该会让你更接近：

Dim Today As Date, TimeReg As Date, UserReg As String, Init As String, _ 
SendFrom As string, SendTo As String, DateFrom As Date, DateTo As Date, _
Comment As String

'Me.txtDateF.value Input f.ex. = 01-01-2020
'Me.txtDateT.value Input f.ex. = 16-01-2020

'Values'
Today = TimeValue(Me!txtDD.Value)
TimeReg = Me!txtTime.Value
UserReg = Left(Me!txtUser.Value, 3)
Init = Me!cmbInit.Value
If IsNull(Me!txtFrom.Value) Then
    SendFrom = ""
Else
    SendFrom = Me!txtFra.Value
End if

SendTo = Me!cmbTo.Column(1)
DateFrom = DateValue(Me!txtDateF.Value)
DateTo = DateValue(Me!txtDateT.Value)
Comment = Me!txtComment.Value

'Define team on which it will use in SQL-Query
Select Case Me!txtTeam.Value
    Case "Team 1"
        Team = "Team1"
        TeamCom = "Team1Com"
    Case "Team 2" etc...
End select

DoCmd.SetWarnings False

Do While DateFrom < DateTo

    strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE [Date] = #" & Format(DateFrom, "yyyy\/mm\/dd") & "#"
    DoCmd.RunSQL strSQL

    ' Correct here. Range of fields doesn't match range of values!
    ChangeSQL = "INSERT INTO tblChanges " & _
        "([Date], [Time], InitChange, TimeR, ShiftB, ShiftA, DateR, DateT, Comment)" & _
        "VALUES (#" & Format(Today, "yyyy\/mm\/dd") & "#, #" & Format(TimeReg, "hh\:nn\:ss") & "#, '" & Init & "', '" & UserReg & "', '" & SendFrom & "', '" & SendTo & "', #" & Format(DateFrom, "yyyy\/mm\/dd") & "#, #" & Format(DateTo, "yyyy\/mm\/dd") & "#, '" & Comment & "');"
    DoCmd.RunSQL ChangeSQL

    DateFrom = DateAdd("d", 1, DateFrom)
Loop

DoCmd.SetWarnings True

或者使用我的函数CSql重写/简化SQL。

Answer 2

我是如何解决这个问题的： 我在上面设置了值

 Date0 = DateAdd("d", 0, CDate(Format(Me.txtDateF.value, "dd/mm/yyyy")))

然后，在 sql 语句中我会这样写

 strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = #" & Format(Date0, "yyyy/mm/dd") & "# "

希望它有所帮助。事实是访问日期一开始也让我感到困惑！

Answer 3

使用帮助函数创建 SQL，您的语句将允许您独立于其余代码测试查询。

Function InsertIntotblChangesSQL(DateOf As Date, _
                                                                                TimeOf As Date, _
                                                                                InitChange As String, _
                                                                                TimeR As Date, _
                                                                                ShiftB As String, _
                                                                                ShiftA As String, _
                                                                                DateR As Date, _
                                                                                DateT As Date, _
                                                                                Comment As String) As String
    Const BaseSQL As String = "INSERT INTO tblChanges([Date], [Time], InitChange, TimeR, ShiftB, ShiftA, DateR, DateT, Comment)"
    Const HashMark As String = "#"
    Const Astrophe As String = "'"
    
    Dim Data(8) As String
    Data(0) = HashMark & DateValue(DateOf) & HashMark
    Data(1) = HashMark & TimeValue(TimeOf) & HashMark
    Data(2) = Astrophe & InitChange & Astrophe
    Data(3) = HashMark & TimeValue(TimeR) & HashMark
    Data(4) = Astrophe & ShiftB & Astrophe
    Data(5) = Astrophe & ShiftA & Astrophe
    Data(6) = HashMark & DateValue(DateValue(DateOf)) & HashMark
    Data(7) = HashMark & DateValue(DateT) & HashMark
    Data(8) = Astrophe & Comment & Astrophe
    
    Dim Values As String
    Values = "VALUES (" & Join(Data, ",") & ")"
    
    InsertIntotblChangesSQL = BaseSQL & vbNewLine & Values
End Function

使用辅助函数，我可以将 SQL 语句打印到即时窗口。然后我将使用 Access 查询设计器来测试 SQL。

使用DateValue() 从日期字段中删除时间值。

WHERE DateValue([Date]) = #" & DateFrom "#"