用于查询 Access 数据库的 Excel VBA 用户定义函数 [英] Excel VBA User-Defined Function to query an Access Database

问题描述

我有一个 Access 365 数据库，其中包含发票编号、到期日和到期金额.我正在尝试创建一个 Excel UDF，借此我输入到期日期和发票编号，然后该函数查询数据库并返回到期金额.

I have an Access 365 database that has Invoice Numbers, Due Dates, and Amounts Due. I'm trying to create an Excel UDF, whereby I input the Due Date and Invoice Number, and the function queries the database and returns the Amount Due.

公式结果是 #Value 并且没有编译器错误，尽管在尝试打开记录集时出现错误(我为此操作设置了错误消息框).也许我的 SQL 有问题?如有任何帮助，我将不胜感激.

The formula result is #Value and there's no compiler error, though there appears to be an error when it attempts to open the record set (I set up a error message box for this action). Perhaps there's an issue with my SQL? I'd appreciate any assistance with this matter.

我发现了一些类似主题的讨论，但我一直无法让这段代码工作.如有任何帮助，我将不胜感激.

I've found several discussions of similar topic, but I've been unable to get this code to work. I'd appreciate any assistance with this matter.

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

推荐答案

看起来你的函数可以明显不那么复杂.

Seems like your function could be significantly less complex.

注释掉错误处理程序，直到从 Sub 调用时它可以正常工作.

Comment out the error handler until you get it working when called from a 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

这篇关于用于查询 Access 数据库的 Excel VBA 用户定义函数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！