Calling MS Excel function from MS Access VBA - vba

Question

I am working an MS Access application a part of which uses Beta Distribution function. Since MS Access does not have Beta Distribution function of its own I'm using calling BetaDist function from MS Excel. I've tested the code in MS Excel and it seems to run successfully. In MS Access also the code is working fine and generating correct results but the time taken by Access is very high than the time taken by Excel. I'm posting the part of code which utilizes BetaDist function and also the slowest portion of the code. I want to reduce the time taken by Access. Any help is appreciated.
Part of Code which utilizes BetaDist:
For i = 1 To UBound(arrBetaParam)
If arrBetaParam(i).Alpha <= 0 Or arrBetaParam(i).Beta <= 0 Or tryOutValue > arrBetaParam(i).ExpValue Then
dblTempEP = 0
Else
If tryOutValue > arrBetaParam(i).LastKnownGoodValue Then
dblTempEP = 0
Else
dblTempEP = 1
End If
Dim bt As Double
bt = -1
On Error Resume Next
bt = Excel.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue)
tj = bt
If bt > -1 Then
If bt > 1 Then bt = 1
If bt < 0 Then bt = 0
arrBetaParam(i).LastKnownGoodValue = tryOutValue
dblTempEP = 1 - bt
End If
On Error GoTo 0
End If
OEP = OEP + dblTempEP * arrBetaParam(i).Rate
'sumRate = sumRate + arrBetaParam(i).Rate
Next

Answer 1

Your code is probably taking so long due to the fact it has to open the Excel application.
BetaDist is not complicated to implement. Why not create a VBA function in Acces VBA. Here is the formula:
f(x) = B(alpha,beta)-1 xalpha-1(1-x)beta-1
Here I found a decent implementation. Didn't test it though:
Option Explicit
Const n As Long = 200 ' increase for accuracy, decrease for speed
Public aa As Double
Public bb As Double
Function BetaDist1(x As Double, a As Double, b As Double)
Dim d1 As Double
Dim d2 As Double
Dim n1 As Long
Dim n2 As Long
aa = a
bb = b
n1 = x * n
n2 = n - n1
d1 = SimpsonInt(0, x, n1)
d2 = SimpsonInt(x, 1, n2)
BetaDist1 = d1 / (d1 + d2)
End Function
Function SimpsonInt(ti As Double, tf As Double, ByVal n As Long) As Double
' shg 2006
' Returns the integral of Func (below) from ti to tf _
using Composite Simpson's Rule over n intervals
Dim i As Double ' index
Dim dH As Double ' step size
Dim dOdd As Double ' sum of Func(i), i = 1, 3, 5, 7, ... n-1, i.e., n/2 values
Dim dEvn As Double ' sum of Func(i), i = 2, 4, 6, ... n-2 i.e., n/2 - 1 values
' 1 + (n/2) + (n/2 - 1) + 1 = n+1 function evaluations
If n < 1 Then Exit Function
If n And 1 Then n = n + 1 ' n must be even
dH = (tf - ti) / n
For i = 1 To n - 1 Step 2
dOdd = dOdd + Func(ti + i * dH)
Next i
For i = 2 To n - 2 Step 2
dEvn = dEvn + Func(ti + i * dH)
Next i
SimpsonInt = (Func(ti) + 4# * dOdd + 2# * dEvn + Func(tf)) * dH / 3# ' weighted sum
End Function
Function Func(t As Double) As Double
Func = t ^ (aa - 1) * (1 - t) ^ (bb - 1)
End Function

Answer 2

You could do like this:
Dim xls As Excel.Application
Set xls = New Excel.Application
' Begin loop.
bt = xls.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue)
' End loop.
xls.Quit
Set xls = Nothing