Excel VBA中SQL Select语句拼接日期时间筛选数据求助

我有一个Excel工作表，内置「今日至未来4天」的日期下拉列表。选择某一日期时，需展示对应日期的采集数据——这些数据的CPTs字段为datetime类型，存储在另一工作表中。我需要在SQL Select语句中将dateBox的文本与cptString变量的文本拼接，筛选出对应datetime的采集数据，但现有VBA代码运行异常。

问题代码 #

Private Sub dateBox_Change()
    Dim connection As New ADODB.connection
    
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
    ";Extended Properties=""Excel 12.0;HDR=YES;"";"
    
    Dim dateQuery As String
    Dim queryString As String
    Dim cptString1 As String
    Dim cptString2 As String
    Dim cptString3 As String
    
    dateQuery = Me.dateBox.Text
    
    cptString1 = "00:30"
    cptString2 = "01:30"
    cptString3 = "02:00"

    queryString = "Select [Lane],[Containerized Packages],[Staged Packages]," & _
    "[Loaded Packages],[Departed Packages],[Expected Packages],[All Packages] " & _
    "from [Data$] where " & _
    "[Lane] = 'SBS2->CC-RM-SWANSEA-GB-H2' or " & _
    "[Lane] = 'SBS2->CC-RM-Cardiff-GB-H2' or " & _
    "[Lane] = 'SBS2->CC-RM-Bristol2-GB-H2' " & _
    "and [CPTs] = dateQuery """ & cptString1 & """ "
    
    
    Dim rs As New ADODB.Recordset
    rs.Open queryString, connection
    
    Dim rSht As Worksheet
    Set rSht = ThisWorkbook.Worksheets("Sheet1")
    
    With rSht
        .Cells.ClearContents
        For i = 0 To rs.Fields.Count - 1
            .Cells(4, i + 1).Value = rs.Fields(i).Name
        Next i
        .Range("A5").CopyFromRecordset rs
    End With
    
    connection.Close
End Sub

相关字段/控件说明 #

• CPTs字段：datetime类型，显示格式为YYYY/MM/DD HH:MM
• 日期下拉框：选项格式为DD/MM/YYYY

修正方案及代码 #

错误点说明 #

1. SQL语句未正确拼接变量dateQuery，直接写入变量名会被数据库当作字符串字面量
2. 逻辑运算符优先级错误：OR与AND共存时，需给OR条件组加括号，否则会导致逻辑判断偏差
3. OLEDB筛选datetime类型需用#包裹日期时间字符串，而非直接拼接
4. 日期格式需统一转换，避免因区域设置导致的解析错误

修正后的代码 #

Private Sub dateBox_Change()
    Dim connection As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim queryString As String
    Dim selectedDate As Date
    Dim fullDateTime1 As String, fullDateTime2 As String, fullDateTime3 As String
    
    ' 处理日期格式，统一转换为标准datetime字符串
    On Error Resume Next
    selectedDate = CDate(Me.dateBox.Text)
    On Error GoTo 0
    ' 若日期转换失败，直接退出
    If IsEmpty(selectedDate) Then Exit Sub
    
    ' 拼接日期与时间，格式化为OLEDB识别的datetime格式
    fullDateTime1 = Format(selectedDate, "yyyy/mm/dd") & " 00:30"
    fullDateTime2 = Format(selectedDate, "yyyy/mm/dd") & " 01:30"
    fullDateTime3 = Format(selectedDate, "yyyy/mm/dd") & " 02:00"
    
    ' 建立数据库连接
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
                    ";Extended Properties=""Excel 12.0;HDR=YES;"";"
    
    ' 构建正确的SQL语句：OR条件加括号，datetime用#包裹，多时间点用IN筛选
    queryString = "SELECT [Lane],[Containerized Packages],[Staged Packages]," & _
                  "[Loaded Packages],[Departed Packages],[Expected Packages],[All Packages] " & _
                  "FROM [Data$] " & _
                  "WHERE ([Lane] = 'SBS2->CC-RM-SWANSEA-GB-H2' OR " & _
                  "[Lane] = 'SBS2->CC-RM-Cardiff-GB-H2' OR " & _
                  "[Lane] = 'SBS2->CC-RM-Bristol2-GB-H2') " & _
                  "AND [CPTs] IN (#" & fullDateTime1 & "#, #" & fullDateTime2 & "#, #" & fullDateTime3 & "#)"
    
    ' 执行查询
    rs.Open queryString, connection
    
    ' 将结果写入Sheet1
    Dim rSht As Worksheet
    Set rSht = ThisWorkbook.Worksheets("Sheet1")
    With rSht
        .Cells.ClearContents
        ' 写入表头
        For i = 0 To rs.Fields.Count - 1
            .Cells(4, i + 1).Value = rs.Fields(i).Name
        Next i
        ' 写入数据
        If Not rs.EOF Then .Range("A5").CopyFromRecordset rs
    End With
    
    ' 关闭连接与记录集
    rs.Close
    connection.Close
    Set rs = Nothing
    Set connection = Nothing
End Sub

内容的提问来源于stack exchange，提问作者F.OLeary