SQL查詢 - 日期範圍無法正常工作

Question

我需要您的幫助來查看下面的代碼。我有一個Access數據庫與用戶表單數據，其中包含一個列與提交日期的條目...基本上是這個代碼的意思是要做的，它應該收集所有條目之間的輸入用戶窗體中的一個特定的數據範圍VBA應用程序並在Excel表單上填充這些日期之間的所有條目。到目前爲止，我已經能夠用下面的代碼稍微得到結果，但它不像預期的那樣運行......

問題是，例如，當我有3個提交一個爲第8個，一個爲第9個和一個十二月十日...如果我選擇12月1日至11日沒有任何東西出現在列表中...當我選擇12月1日至12日，那麼所有這3人都是人口。如果我從上個月選擇到12月第12，沒有人滿足...你可以請看看下面的代碼，讓我知道你在想什麼:)

這是如何將數據存儲到訪問服務器（以防萬一那將是問題我包括這個）

Dim todaydate As DateTime 
    Dim time As Date 



    todaydate = DateTime.Now.ToString("dd/MM/yyyy") 
    time = DateTime.Now.ToString("HH:mm:ss") 

    hideform() 

    Panel_RenewForm.Width = 636 
    Panel_RenewForm.Height = 201 
    Panel_RenewForm.Visible = True 


    Panel_RenewForm.Location = New Point(12, 191) 
    Btn_Submit.Visible = False 
    Btn_Clear.Visible = False 



    Dim provider As String 
    Dim dataFile As String 
    Dim connString As String 
    Dim myConnection As OleDbConnection = New OleDbConnection 


    provider = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" 
    dataFile = "C:\Users\ssroujian\Documents\nsltrackerreport.accdb" 
    connString = provider & dataFile 
    myConnection.ConnectionString = connString 
    myConnection.Open() 

    Dim str As String 


    ' remember to add the ID of every column in the access database here 
    str = "Insert into nsltrackerreport([CBSID],[AgentName],[Supervisor],[SkillSet],[Location],[DOH],[AccountNumber],[SupportType],[CallDescription],[CallDetails],[Resolution],[FollowupRequired],[ColdTransfer],[VerifiedPipe],[MissInformed],[PrevCBSID],[NSLAgent],[SubmitDate],[SubmitTime]) Values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" 

    Dim cmd As OleDbCommand = New OleDbCommand(str, myConnection) 




    'this will pass values of controls to the access database to the designated column. 
    cmd.Parameters.Add(New OleDbParameter("CBSID", CType(Combo_CBSID.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("AgentName", CType(Combo_AgentName.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("Supervisor", CType(Combo_Supervisor.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("SkillSet", CType(Combo_SkillSet.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("Location", CType(Combo_Location.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("DOH", CType(combo_DOH.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("AccountNumber", CType(txt_AccountNumber.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("SupportType", CType(Combo_SupportType.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("CallDescription", CType(Combo_CallDescription.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("CallDetails", CType(Combo_CallDetails.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("Resolution", CType(txt_Resolution.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("FollowupRequired", CType(txt_FollowupRequired.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("ColdTransfer", CType(txt_ColdTransfer.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("VerifiedPipe", CType(txt_VerifiedPipe.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("MissInformed", CType(txt_AgentMissInformed.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("PrevCBSID", CType(Combo_Prev_AgentCBSID.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("NSLAgent", CType(lbl_NSLAgentName.Text, String))) 
    cmd.Parameters.Add(New OleDbParameter("SubmitDate", CType(todaydate, String))) 
    cmd.Parameters.Add(New OleDbParameter("SubmitTime", CType(time, String))) 




    Try 

     cmd.ExecuteNonQuery() 
     cmd.Dispose() 
     myConnection.Close() 


    Catch ex As Exception 
     MsgBox("Unable to connect to NSL Tracker reporting database, please contact administrator and advise of the error below :" & vbCrLf & vbCrLf & ex.Message, vbCritical, "Connection Unsuccessful") 

     Exit Sub 

    End Try 



    clearfields() 


End Sub 

，這是它是如何在Excel文件捕獲根據選定的日期範圍：

Dim i     As Long 
Dim CN     As New ADODB.Connection 
Dim RS     As New ADODB.Recordset 
Dim FSO     As New FileSystemObject 
Dim F     As File 
Dim DBPassword   As String 
Dim strSQL    As String 
Dim DestinationSheet As Worksheet 

On Error Resume Next 
Set F = FSO.GetFile("C:\Users\ssroujian\Documents\nsltrackerreport.accdb") 
On Error GoTo 0 
If F Is Nothing Then 
    GoTo ExitSub: 
End If 
DBPassword = "" 
Set DestinationSheet = Worksheets("Sheet1") 
'Use SQL's SELECT and FROM statements for importing Table. 

strSQL = "SELECT nsltrackerreport.* FROM nsltrackerreport WHERE SubmitDate >= #" & DTPickerCtrl1.Value & "# AND SubmitDate <= #" & DTPickerCtrl2.Value & "#" 

'connection string 
CN.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "C:\Users\ssroujian\Documents\nsltrackerreport.accdb" & ";Jet OLEDB:Database Password=" & DBPassword 
'Open connection 
CN.Open 
RS.Open strSQL, CN, , , adCmdText 
'Clear the destination worksheet. 
DestinationSheet.Cells.Clear 
Sheet1.Range("A3").CopyFromRecordset RS 

    'Reinstate field headers (assumes a 4-column table). 
    'Note that the ID field will also transfer into column A, 
    'so you can optionally delete column A. 
    Sheet1.Range("A1:U1").Value = _ 
    Array("ID", "CBSID", "AgentName", "Supervisor", "SkillSet", "Location", "DOH", "AccountNumber", "SupportType", "CallDescription", "CallDetails", "Resolution", "FollowupRequired", "ColdTransfer", "VerifiedPipe", "MissInformed", "PrevCBSID", "PrevAgent", "NSLAgent", "SubmitDate", "SubmitTime") 

RS.Close 
CN.Close 

ExitSub: 

Set RS = Nothing 
Set CN = Nothing 
Set F = Nothing 
Set FSO = Nothing 

下面介紹一下SQLstr的一個MsgBox給出：

Answer 1

使用YYYY-MD您提交給Access數據庫引擎的日期值的格式爲。

strSQL = "SELECT nsltrackerreport.* FROM nsltrackerreport " & _ 
    "WHERE SubmitDate >= #" & Format(DTPickerCtrl1.Value, "yyyy-m-d") & _ 
    "# AND SubmitDate <= #" & Format(DTPickerCtrl2.Value, "yyyy-m-d") & "#"