Excel VBA User-Defined Function to query an Access Database

Question

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.

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/

Here's the code:

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

Can you please try removing the semicolon at the end of the SQL query and run? — Govind
– Govind, Commented Aug 14, 2020 at 7:55
Call your function from a Sub, not from a worksheet cell. Then you can see and debug the problem. — Tim Williams
– Tim Williams, Commented Aug 14, 2020 at 18:47
@Govind: I removed the semicolon and the same issue occurred. — SouthernNerdly
– SouthernNerdly, Commented Aug 14, 2020 at 20:04
@TimWilliams: I called the function from a Sub, and when I went to debug, the error appears to relate to: rs. Open SqlQuery, conn — SouthernNerdly
– SouthernNerdly, Commented Aug 14, 2020 at 20:05
Try SELECT [Value] FROM tblRawCallData WHERE [DueDate] = " & inpDate & " AND [Invoice] = " & inpInvoiceNum Also - what is the specific error message you get? — Tim Williams
– Tim Williams, Commented Aug 14, 2020 at 20:14

Gustav · Accepted Answer · 2020-08-14 20:37:49Z

1

You need two or three corrections, as date values always should be handled as DateTime, and your invoice number most likely is numeric:

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 & "));"

Edit for numeric "date" and alpha-numeric invoice:

SqlQuery = "SELECT [Value] FROM tblRawCallData WHERE (([DueDate] = #" & Format(inpDate, "@@@@\/@@\/@@") & "#) AND ([Invoice] = '" & inpInvoiceNum & "'));"

edited Aug 14, 2020 at 20:37

answered Aug 14, 2020 at 7:56

Gustav

56.3k7 gold badges33 silver badges65 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

SouthernNerdly Over a year ago

The date is numeric in the database (i.e. 20190631) and the invoice number is alphanumeric (i.e. RC51841A).

Gustav Over a year ago

You should never store dates like that, which - as you just have shown - allows for invalid dates. Always use DateTime. But see extended answer, please.

SouthernNerdly Over a year ago

Thank you. This database data is received from a third party vendor via imported text file and the dates are already in the number format. Still, storing the dates using DateTime makes sense and I'll absolutely have to make that adjustment soon.

Tim Williams · Accepted Answer · 2020-08-14 20:59:56Z

0

Seems like your function could be significantly less complex.

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

answered Aug 14, 2020 at 20:59

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

1 Comment

SouthernNerdly Over a year ago

Thank you Tim, and everyone else who's contributed! My problem is solved!

Collectives™ on Stack Overflow

Excel VBA User-Defined Function to query an Access Database

2 Answers 2

3 Comments

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related