VBA Error 115 - Error loading the dataprovider

[chogben]

I've created several VBA data providers. 95%+ of the time they work great, but every now and again I get error 115.

Does anyone have any information on this error? Has anyone else encountered this?

Here's a sample provider - it picks 10 rows at random from any DP, copying it's structure as well. I can trap the error, but at the time it's trapped, BO behaves strangely enough to make you want to shut it down and restart.



Private Const QUERYNAME As String = "qryAllClaims" 'change this to the name of your 'input' provider
Private Const NCLAIMS As Long = 10
Private m_lngRandomNumbers() As Long

Public Sub RandomNClaims(dpInterface As DpVBAInterface)
'Purpose: A vba data provider that returns a number of claims (nclaims) from the
' queryname dataprovider picked at random.
' if the provider has the same or fewer records - all of these will just be
' returned
' An effort is made to ensure that the same claim is not picked more than once
'Author:Chris Hogben
'Date Started: 23/08/2002
'Arguments: dpInterface

Dim objInputDP As DataProvider
Dim lngNumberOfRows As Long
Dim objInputDPColumn As Column
Dim objCube As DpVBACube
Dim lngCount As Long
Dim lngItemCount As Long
Dim lngRecordsUBound As Long

On Error GoTo Err_RandomNClaims

Set objInputDP = ActiveDocument.DataProviders(QUERYNAME)

lngNumberOfRows = objInputDP.NbRowsFetched

'check that input data provider has more rows than nclaims
'if it hasn't just return what there is
If lngNumberOfRows <= NCLAIMS Then
ReDim m_lngRandomNumbers(1 To lngNumberOfRows)
For lngCount = 1 To lngNumberOfRows
m_lngRandomNumbers(lngCount) = lngCount
Next
lngRecordsUBound = lngNumberOfRows
Else
'input data provider has more than the minimum number of rows
'we now need to pick some at random
ReDim m_lngRandomNumbers(1 To NCLAIMS)
GenerateRandomNumbers lngNumberOfRows, NCLAIMS
lngRecordsUBound = NCLAIMS
'module level variable m_lngRandomNumbers is now initialised
End If
'Now we need to return a data provider with the same structure as the
'input dp

'set up cube
Set objCube = dpInterface.DpVBACubes.Item(1)
'set up number of columns in the cube
objCube.DpVBAColumns.SetNbColumns objInputDP.Columns.Count


'create a copy of each column in the input dataprovider
lngCount = 1
For Each objInputDPColumn In objInputDP.Columns
With objCube.DpVBAColumns.Item(lngCount)
.Name = objInputDPColumn.Name
End With
lngCount = lngCount + 1
Next

'add data to each column
For lngCount = 1 To lngRecordsUBound
For lngItemCount = 1 To objCube.DpVBAColumns.Count
objCube.DpVBAColumns.Item(lngItemCount).Item(lngCount) = objInputDP.Columns(lngItemCount).Item(m_lngRandomNumbers(lngCount))
Next
Next

dpInterface.CheckDataIntegrity (boCheckAll)

exit_RandomNClaims:
Exit Sub

Err_RandomNClaims:
MsgBox &quot;ERROR!&quot; & Err.Number & &quot; :&quot; & Err.Description

Stop 'only for debugging - remove in production version
Set dpInterface = Nothing

End Sub

Private Sub GenerateRandomNumbers(ByVal lngMaxNumber As Long, _
ByVal lngArrayUBound As Long)
'Purpose: Fills the module level variable m_lngRandomNumbers with random numbers
'Author:Chris Hogben
'Date started:23/08/2002
'Arguments: lngMaxNumber - random numbers must be between 1 and lngMaxNumber
'Variables: lngCount
Dim lngCount As Long
Dim lngSearchLoopCount As Long
Dim lngRandomNumber As Long
Dim blnFound As Boolean

On Error GoTo Err_GenerateRandomNumbers

'clear array of existing values
Erase m_lngRandomNumbers
ReDim m_lngRandomNumbers(1 To lngArrayUBound)
Randomize
lngCount = 1
Do
'generate random number
lngRandomNumber = CLng((lngMaxNumber * Rnd) + 1)

'check if we've already picked this random number
blnFound = False
For lngSearchLoopCount = 1 To lngCount
If m_lngRandomNumbers(lngSearchLoopCount) = lngRandomNumber Then
blnFound = True
Exit For
End If
Next

If Not blnFound Then
m_lngRandomNumbers(lngCount) = lngRandomNumber
lngCount = lngCount + 1
End If
Loop Until lngCount > lngArrayUBound

Exit_GenerateRandomNumbers:
Exit Sub
Err_GenerateRandomNumbers:
Debug.Print Err.Number & &quot;:&quot; & Err.Description
Stop
Resume Exit_GenerateRandomNumbers
End Sub