在 VBA 中使用 DAO QueryDef 时出现“未定义函数”
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7100372/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
'Undefined function' when using DAO QueryDef in VBA
提问by sigil
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.
我正在将 Access 2007 查询分配给 Excel VBA 中的 QueryDef。我的查询调用用户定义的函数，因为它对使用正则表达式评估字段的结果执行计算。我使用 QueryDef 是因为我在用户窗体中收集值并希望将它们作为参数传递给查询。
When I run my VBA code, I get an error: "Run-time error '3085': Undefined function 'regexFunc' in expression."
当我运行 VBA 代码时，出现错误：“运行时错误‘3085’：表达式中未定义函数‘regexFunc’。”
This questionsuggests 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.
这个问题表明问题是DAO无法从Excel调用Access UDF，因此我将我的UDF复制到Excel VBA模块中，但仍然出现错误。
Access query:
访问查询：
select field1 from dataTable where regexFunc(field1)=[regexVal]
Here's the Excel VBA code:
这是 Excel VBA 代码：
'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
采纳答案by sigil
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:
这是过滤函数，它创建一个新数组，用通过 UDF 布尔检查的行填充它，并返回它：
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
回答by transistor1
This is how I would do it... just tested it and it works fine with my UDF:
这就是我要做的……只是测试了一下，它在我的 UDF 上运行良好：
One thing - are you required to notuse New Access.Application?
一件事 - 您是否需要不使用 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
Notethat I made my underlying query a SELECT ... INTO query that creates a table called 'dataTableResults'
请注意，我将基础查询设为 SELECT ... INTO 查询，该查询创建了一个名为“dataTableResults”的表
This is my query (QueryDef) in Access:
这是我在 Access 中的查询 (QueryDef)：
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.
我的 MS-Access 数据库有一个名为“mysqr”的函数，它在上面的 SQL 中使用。
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.
我查询的表“dataTable”只是一个数字列表，所以如果我的参数“avalue”是“16”，那么我会得到“4”行。如果我输入“4”（在我的代码中），我会得到“2”。
