Question

我需要您的帮助才能查看下面的代码。我有一个带有userform条目数据的Access数据库，其中包含一个包含条目提交日期的列...基本上这个代码的目的是做什么，它应该收集在UserForm中输入的特定数据范围之间的所有条目。 VBA应用程序并在Excel工作表上填充这些日期之间的所有条目。到目前为止，我已经能够通过下面的代码得到一些结果，但它的行为不符合预期...

问题在于，例如..我有3个提交一个用于第8个，一个用于第9个，一个用于12月10日...如果我选择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-m-d 格式用于您提交给Access数据库引擎的日期值。

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

SQL查询 - 日期范围无法正常工作

1 个答案: