Extract employees between 2 Hire Dates VBA and SQL

Question

I have designed a macro which should extract from a workbook database all employees who were hired between 2 Dates.

Unfortunatley I'm getting a error mesage when I run the query.

Error: Data Type mismatch in criteria expression.

I don't know how to fix the issue.

My regional settings:

Short date: dd.MM.yyyy Long date: dddd, d.MMMM.yyyy First day of week: Monday

Here the code:

Public Sub HIREDATE()
Application.ScreenUpdating = False

Dim cnStr As String
Dim rs As ADODB.Recordset
Dim query As String
Dim fileName As String
Dim pom1 As String
Dim x As String, w, e, blad As String, opis As String
Set w = Application.FileDialog(msoFileDialogFilePicker)
With w
.AllowMultiSelect = False

    If .Show = -1 Then
    fileName = w.SelectedItems(1)
    Else
    Exit Sub
    End If

End With

    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=" & fileName & ";" & _
               "Extended Properties=Excel 12.0"

On Error GoTo Anuluj
x = InputBox("Wprowadz dwie daty od do oddzielając je przecinkiem -- Przykład 01.01.2015,01.05.2015")



       strg = ""

       k = Split(x, ",")
                e = Application.CountA(k)
        For m = LBound(k) To UBound(k)

            If e = 1 Then
            strg = strg & " [DEU1$].[Last Start Date] = '" & k(m) & "';"
            Exit For
            ElseIf e = 2 And e Mod 2 = 0 Then
            strg = " [DEU1$].[Last Start Date] BETWEEN '" & CDate(k(m)) & "' AND '" & CDate(k(m + 1)) & "';"
            Exit For
            End If

        Next m

On Error GoTo opiszblad

    Set rs = New ADODB.Recordset

query = "SELECT [Emplid], [First Name]+ ' ' +[Last Name] From [DEU1$] WHERE" & strg

    rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified

    Cells.Clear

Dim cell As Range, i As Long

    With Range("A3").CurrentRegion
    .Select
        For i = 0 To rs.Fields.Count - 1
            .Cells(1, i + 1).Value = rs.Fields(i).Name
        Next i


    Range("A4").CopyFromRecordset rs
    .Cells.Select

    .EntireColumn.AutoFit
    End With

    rs.Close
Application.ScreenUpdating = True

Exit Sub

Anuluj:

Exit Sub

opiszblad:
e = Err.Number
blad = Err.Source
opis = Err.Description
opisbledu = MsgBox(e & " " & blad & " " & opis, vbInformation, "Błąd")
Exit Sub
End Sub

Gustav Gustav · Accepted Answer · 2015-06-02T07:15:26

You need properly formatted string expressions for your dates and to validate the user input:

If e = 1 And IsDate(k(m)) Then
    strg = strg & " [DEU1$].[Last Start Date] = #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "#;"
    Exit For
ElseIf e = 2 And e Mod 2 = 0 And IsDate(k(m + 1)) Then
    strg = " [DEU1$].[Last Start Date] BETWEEN #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "# AND #" & Format(DateValue(k(m + 1)), "yyyy\/mm\/dd") & "#;"
    Exit For
End If

Extract employees between 2 Hire Dates VBA and SQL

1 Answers