Problem with passed date variable to SQl statement retrieving from Access

deailes

New Member
Joined
Feb 7, 2016
Messages
8
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.

Code:
'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]
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

deailes

New Member
Joined
Feb 7, 2016
Messages
8
Turns out the answer was to format the PullDate Variable as follows:

Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,216
Messages
5,594,886
Members
413,947
Latest member
gizmolucy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top