0

I have a macro that assembles an SQL query to send to Access. It was working fine with 5 variables (excel values)

When I add a sixth, the error in the title is generated.

Screenshot attached on line in execution prior to error. Mouse held over variable to show value.80040e07

Public Sub sum()
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Set cn = CreateObject("ADODB.Connection")
strConnection =Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\Gr-001\data\GR-DEPTS\999-SHRD\data\GRHours.accdb;"
'validation
If Range("B3").Value <> "" And (Range("B4").Value <> "" Or Range("C4").Value <> "") Then
MsgBox "You cannot have both single date and date range entered at the same time.", vbOKOnly + vbCritical, "Error"
Exit Sub
End If
Dim w As String

'beginning of SQL string
strSql = "select sum(hours) from GRHours "

w = ""

'check criteria for employee
If Range("B2").Value <> "" Then w = w & " employee = '" & Range("B2").Value & "' "

'check criteria for date (single)
If Range("B3").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " [date] = CDATE('" & Range("B3").Value & "') "
End If

'check criteria for date (beginning)
If Range("B4").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " [date] >= CDATE('" & Range("B4").Value & "') "
End If

'check criteria for date (end)
If Range("C4").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " [date] <= CDATE('" & Range("C4").Value & "') "
End If

'check criteria for job
If Range("B6").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " job = '" & Range("B6").Value & "' "
End If

'check criteria for task
If Range("B7").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " task = '" & Range("B7").Value & "' "
End If

'NEW INSERTION HERE - check criteria for week
If Range("B5").Value <> "" Then
If w <> "" Then w = w & " AND "
w = w & " week = '" & Range("B5").Value & "' "
End If
'END NEW INSERTION


'end of SQL string
If w <> "" Then strSql = strSql & " WHERE " & w

'send string to access
cn.Open strConnection
Set rs = cn.Execute(strSql)
ActiveSheet.Range("B9").CopyFromRecordset rs
'End If
End Sub
Community
  • 1
  • 1

0 Answers0