如何解决Excel VBA用户定义的函数来查询Access数据库
我有一个Access 365数据库，该数据库具有发票编号，到期日期和到期金额。我正在尝试创建一个Excel UDF，在其中输入截止日期和发票编号，然后该函数查询数据库并返回应付金额。
公式结果为#Value，并且没有编译器错误，尽管在尝试打开记录集时似乎出现了错误（我为此操作设置了一个错误消息框）。也许我的SQL有问题？感谢您在此问题上的协助。
我已经找到了类似主题的一些讨论，但是我无法使此代码正常工作。感谢您在此问题上的协助。
这是代码：
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!","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!","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!","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: ","Records"
' Close the recordset
Else
'Not found; return #N/A! error
CLLData = CVErr(xlErrNA)
MsgBox "No records in recordset!","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处理，并且发票编号很可能是数字：
start_date = datetime.date(2020,1,1)
end_date = datetime.date(2020,2,1)
time_between_dates = end_date - start_date
days_between_dates = time_between_dates.days
random_number_of_days = random.randrange(days_between_dates)
random_date = start_date + datetime.timedelta(days=random_number_of_days)
print(random_date)
编辑以获取数字“日期”和字母数字发票：
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 & "));"
好像您的函数可能要复杂得多。
注释掉错误处理程序，直到从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
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。