Problem with passed date variable to SQl statement retrieving from Access

[deailes]

Hiya guys.

I am struggling with the SQL part of this code. The commented out part of the sql statement works with my access DB and will pull back emails with date value of today minus 72 days. I want to however change this so that i can reference a cell in the excel spreadsheet. "D2" and then calculate the first day of the month, for 2 months previous.

I have declared DateStart and PullDate to then calculate the date required. IE so if "D2" contained 10/02/2016 then i expect PullDate to = 01/12/2015

The Immediate Window looks like the SQL statement is correct and is working as the date shows as 01/12/2015 so i expect data from this date going forward. I am wondering if i have something wrong with Date format or if there is a problem passing the date variable from excel into SQL to retrieve from Access.

'Debug.print

SELECT DISTINCT [To Email Address], [Sent on] FROM BBEmails WHERE [Sent on] >= 01/12/2015 ORDER BY [Sent on] DESC 


[\Code]



What is currently happening is that the data pulled back is ignore the date value and pulling all entries within the access table going back to 2014.

Can anyone see my mistake ??

[Code]

Sub Bounceback()
    
    Dim con         As Object
    Dim rs          As Object
    Dim AccessFile  As String
    Dim strTable    As String
    Dim SQL         As String
    Dim i           As Integer
    Dim Sure        As Integer
    Dim DateStart   As String    ' initially declared this value as Date
    Dim PullDate    As String     ' initially declared this value as Date
    
    
    DateStart = CDate(Worksheets(1).Range("D2").Value)
    PullDate = CDate(DateSerial(Year(DateStart), Month(DateStart) - 2, 1))
    
    Sure = MsgBox("You are about to run the bounce back macro. Are you sure you want to do this?", vbOKCancel)
    
    If Sure = 2 Then Exit Sub
                
    'Disable screen flickering.
    Application.ScreenUpdating = False
    
    'Add a new sheet in the report that the data can be imported to.
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    ActiveSheet.Name = "BBEmailsData"
   
    'Specify the file path of the accdb file. 
        AccessFile = "D:\TESTDB\BBEmailsTEST.accdb"
    
    'Set the name of the table you want to retrieve the data.
    strTable = "BBEmails"
    
    On Error Resume Next
    'Create the ADODB connection object.
    Set con = CreateObject("ADODB.connection")
    'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Connection was not created!", vbCritical, "Connection Error"
        Exit Sub
    End If
    On Error GoTo 0
    
    'Open the connection.
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
    
    'Create the SQL statement to retrieve the data from table.
    'Get the necessary information Emails and date they were sent. Ensuring that date sent is in decending order so its possible to always find the most recent record first
    'SQL = "SELECT DISTINCT [To Email Address], [Sent On] FROM " & strTable & " WHERE [Sent On] >Date()-72 ORDER BY [Sent On] DESC "
    SQL = "SELECT DISTINCT [To Email Address], [Sent on] FROM " & strTable & " WHERE [Sent on] >= " & PullDate & " ORDER BY [Sent on] DESC "
    
    
    Debug.Print SQL


    On Error Resume Next
    'Create the ADODB recordset object.
    Set rs = CreateObject("ADODB.Recordset")
    'Check if the object was created.
    If Err.Number <> 0 Then
        'Error! Release the objects and exit.
        Set rs = Nothing
        Set con = Nothing
        'Display an error message to the user.
        MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
        Exit Sub
    End If
    On Error GoTo 0
         
    'Set the cursor location.
    rs.CursorLocation = 3 'adUseClient on early  binding
    rs.CursorType = 1 'adOpenKeyset on early  binding
    
    'Open the recordset.
    rs.Open SQL, con
    
    'Check if the recordet is empty. This means no records existing that match the SQL string criteria.
    If rs.EOF And rs.BOF Then
        'Close the recordet and the connection.
        rs.Close
        con.Close
        'Release the objects.
        Set rs = Nothing
        Set con = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If
    
    'Copy the recordset headers.
    For i = 0 To rs.Fields.Count - 1
        Sheets("BBEmailsData").Cells(1, i + 1) = rs.Fields(i).Name
    Next i
    
    'Write the query values in the sheet.
    Sheets("BBEmailsData").Range("A2").CopyFromRecordset rs
    
    'Close the recordet and the connection.
    rs.Close
    con.Close
    
    'Release the objects.
    Set rs = Nothing
    Set con = Nothing
    
    'Adjust the columns' width.
    Sheets("BBEmailsData").Columns("A:E").AutoFit
    
    'Enable the screen.
    Application.ScreenUpdating = True



[\Code]

 

[deailes]

Turns out the answer was to format the PullDate Variable as follows:

PullDate = Format$(PullDate, "\#mm\/dd\/yyyy\#")
[\code]

Just added this line of code to the above without changing anything else and now works as expected.