在VBA中使用DAO QueryDef时的“未定义函数" [英] 'Undefined function' when using DAO QueryDef in VBA

问题描述

我正在将Access 2007查询分配给Excel VBA中的QueryDef.我的查询调用了一个用户定义的函数，因为它会对使用正则表达式评估字段的结果进行计算.我使用QueryDef是因为我正在用UserForm收集值，并希望将它们作为参数传递给查询.

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.

运行VBA代码时，出现错误:运行时错误'3085':表达式中未定义的函数'regexFunc'."

When I run my VBA code, I get an error: "Run-time error '3085': Undefined function 'regexFunc' in expression."

此问题提示问题是DAO无法从Excel调用Access UDF，因此我将UDF复制到Excel VBA模块中，但是仍然出现错误.

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.

访问查询:

select field1 from dataTable where regexFunc(field1)=[regexVal]

这是Excel VBA代码:

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

推荐答案

我已经解决了这个问题.这是我的方法.

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

以下是过滤功能，该功能创建一个新数组，并使用通过UDF布尔检查的行填充该数组，然后将其返回:

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

这篇关于在VBA中使用DAO QueryDef时的“未定义函数"的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！