我有一个Access 365数据库，其中包含发票号、到期日期和到期金额。我正在尝试创建一个Excel UDF，通过它输入到期日期和发票编号，函数查询数据库并返回到期金额。
公式的结果是#Value，没有编译器错误，尽管它试图打开记录集时似乎出现了错误(我为此操作设置了一个错误消息框(。也许我的SQL有问题？我很感激在这件事上能得到任何帮助。
我已经找到了几个类似主题的讨论，但我一直无法使此代码发挥作用。我很感激在这件事上能得到任何帮助。
https://www.mrexcel.com/board/threads/need-help-creating-user-defined-functions-in-excel-to-query-from-a-database.943894/
这是代码：
Function CLLData(inpDate As Long, inpInvoiceNum As String)
Dim conn As Object
Dim rs As Object
Dim AccessFilePath As String
Dim SqlQuery As String
Dim sConnect As String
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file.
AccessFilePath = ThisWorkbook.Path & "" & "CRDD.accdb"
'Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFilePath
On Error Resume Next
'Create the Connection object.
Set conn = CreateObject("ADODB.Connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
'Exit Sub
End If
On Error GoTo 0
On Error Resume Next
'Open the connection.
conn.Open sConnect
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not opened!", vbCritical, "Connection Open Error"
'Exit Sub
End If
On Error GoTo 0
'SQL statement to retrieve the data from the table.
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = '" & inpDate & "') AND ([Invoice] = '" & inpInvoiceNum & "'));"
On Error Resume Next
'Create the ADODB recordset object
Set rs = CreateObject("ADODB.Recordset")
'Check if the object was created.
If Err.Number <> 0 Then
Set rs = Nothing
Set conn = Nothing
MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
'Exit Sub
End If
On Error GoTo 0
On Error Resume Next
'Open the recordset.
rs.Open SqlQuery, conn
'Check if the recordset was opened.
If Err.Number <> 0 Then
Set rs = Nothing
Set conn = Nothing
MsgBox "Recordset was not opened!", vbCritical, "Recordset open error"
'Exit Sub
End If
On Error GoTo 0
' Check there is data.
If Not rs.EOF Then
' Transfer result.
CLLData = rs!Value
MsgBox "Records: ", vbCritical, "Records"
' Close the recordset
Else
'Not found; return #N/A! error
CLLData = CVErr(xlErrNA)
MsgBox "No records in recordset!", vbCritical, "No Records"
End If
rs.Close
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
'Enable the screen.
Application.ScreenUpdating = True
End Function
您需要两到三次更正，因为日期值始终应按DateTime处理，而您的发票编号很可能是数字：
Function CLLData(inpDate As Date, inpInvoiceNum As String)
' <snip>
'SQL statement to retrieve the data from the table.
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = #" & Format(inpDate, "yyyy/mm/dd") & "#) AND ([Invoice] = " & inpInvoiceNum & "));"
编辑数字"；日期"；和字母数字发票：
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = #" & Format(inpDate, "@@@@/@@/@@") & "#) AND ([Invoice] = '" & inpInvoiceNum & "'));"
似乎您的函数可以显著降低复杂性。
注释掉错误处理程序，直到您在从Sub.调用时使其工作
Function CLLData(inpDate As Long, inpInvoiceNum As String)
Dim conn As Object
Dim rs As Object
Dim AccessFilePath As String
Dim SqlQuery As String
Dim sConnect As String
AccessFilePath = ThisWorkbook.path & "" & "CRDD.accdb"
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFilePath
On Error GoTo haveError
Set conn = CreateObject("ADODB.Connection")
conn.Open sConnect
SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE [DueDate] = " & inpDate & _
" AND [Invoice] = '" & inpInvoiceNum & "'"
Set rs = CreateObject("ADODB.Recordset")
rs.Open SqlQuery, conn
If Not rs.EOF Then
CLLData = rs.Fields("Value").Value
Else
CLLData = CVErr(xlErrNA)
End If
rs.Close
Exit Function
haveError:
CLLData = "Error:" & Err.Description
End Function