I'm assigning an Access 2007 query to a QueryDef in Excel VBA. My query calls a user-defined function, because it performs a calculation on the results of evaluating a field with a regular expression. I'm using a QueryDef because I'm collecting values in a UserForm and want to pass them to the query as parameters.
When I run my VBA code, I get an error: "Run-time error '3085': Undefined function 'regexFunc' in expression."
This question suggests that the problem is that DAO is unable to call Access UDFs from Excel, so I copied my UDF into the Excel VBA module, but I still get the error.
Access query:
select field1 from dataTable where regexFunc(field1)=[regexVal]
Here's the Excel VBA code:
'QueryDef function
Sub makeQueryDef (str As String)
Dim qdf As QueryDef
Dim db As Database
Set db = OpenDatabase(DBpath)
Set qdf = db.QueryDefs("paramQuery")
qdf.Parameters("regexVal") = (str="test")
doSomething qdf
End Sub
'Regex function copied from Access VBA module to Excel VBA module
Function regexFunc(str As String) As Boolean
Dim re As RegExp
Dim matches As MatchCollection
regexFunc = False
Set re = New RegExp
re.Pattern = "\reg[ex](pattern)?"
Set matches = re.Execute(str)
If matches.Count <> 0 Then
regexFunc = True
End If
End Function
This is how I would do it... just tested it and it works fine with my UDF:
One thing - are you required to not use New Access.Application?
Sub GetMyDataWithUDF()
Dim oApp As Access.Application
Dim qd As QueryDef
sFileName = "C:\Users\AUser\Desktop\adatabase.mdb"
Set oApp = New Access.Application
oApp.OpenCurrentDatabase (sFileName)
Set qd = oApp.CurrentDb.QueryDefs("Query1")
If oApp.DCount("*", "MSysObjects", "Name='dataTableResults'") > 0 Then _
oApp.CurrentDb.TableDefs.Delete "dataTableResults"
qd.Parameters("avalue") = "4"
qd.Execute
oApp.Quit
Set oApp = Nothing
Dim oRS As ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFileName & ";User Id=admin;Password=;"
Set oRS = New ADODB.Recordset
oRS.Open "SELECT * FROM dataTableResults", sConn
Sheet1.Cells.Clear
Sheet1.Range("A1").CopyFromRecordset oRS
oRS.Close
Set oRS = Nothing
End Sub
Note that I made my underlying query a SELECT ... INTO query that creates a table called 'dataTableResults'
This is my query (QueryDef) in Access:
SELECT dataTable.Field1, dataTable.Field2 INTO dataTableResults
FROM dataTable
WHERE mysqr(dataTable.Field1)=[avalue];
My MS-Access DB has a function called "mysqr", which gets used in the SQL above.
Function mysqr(Num)
mysqr = Num * Num
End Function
The table "dataTable" I'm querying against is just a list of numbers, so if my parameter "avalue" is "16", then I get the row "4" back. If I enter "4" (as in my code), I get "2" back.
I've solved this. Here's how I did it.
First I change the query into a recordset and pass it to my filtering function:
function filteredQDF(qdf As QueryDef, boolVal As Boolean) As Variant
Dim rs As Recordset
Dim rows_rs As Variant
Dim rs_new As Recordset
Dim filtered As Variant
Set rs = qdf.OpenRecordset
rs.MoveLast
rs.MoveFirst
rows_rs = rs.GetRows(rs.RecordCount)
rows_rs = Application.WorksheetFunction.Transpose(rows_rs)
filtered = filterFunction(rows_rs, boolVal)
filteredQDF = filtered
End Function
And here's the filtering function, which creates a new array, populates it with rows that pass the UDF's boolean check, and returns it:
Function filterFunction(sourceArray As Variant, checkValue As Boolean) As Variant
Dim targetArray As Variant
Dim cols As Long
Dim targetRows As Long
Dim targetCursor As Long
'get # of columns from source array
cols = UBound(sourceArray, 2)
'count total number of target rows because 2D arrays cannot Redim Preserve
'checking sourceArray(r,2) because that's the criterion column
targetRows = 0
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
targetRows = targetRows + 1
End If
Next
'set minimum target rows to 1 so that function will always return an array
If targetRows = 0 Then
targetRows = 1
End If
'redim target array with target row count
ReDim targetArray(targetRows, cols)
'set cursor for assigning values to target array
targetCursor = 0
'iterate through sourceArray, collecting UDF-verified rows and updating target cursor to populate target array
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
For c = 1 To cols
targetArray(targetCursor, c - 1) = sourceArray(r, c)
Next
targetCursor = targetCursor + 1
End If
Next
'assign return value
filterFunction = targetArray
End Function
