Hello,
I'm an experience Excel VBA coder venturing into the Access unknown. For anyone familar with the Bloomberg COM V3 API, I'm attempting to marry that to our Portfolio Management Access Database. Here's my problem:
As I'm stepping through the return data from Bloomberg and inserting it into my table, after 5 fields it gives me an "Run-time error '7': Out of memory". MSACCESS is not using any additional memory, and the task manager performance windows don't show any spike in activity. This same code works just fine inserting the same data into an excel worksheet.
Anyone have any ideas? I am the only user of this data. Thanks.
Code:
Private Sub session_ProcessEvent(ByVal obj As Object)
On Error GoTo errHandler
Dim eventObj As blpapicomLib.Event
Dim dbs As DAO.Database
Dim rstbl1 As DAO.Recordset
Dim rstbl2 As DAO.Recordset
Set eventObj = obj
Set dbs = CurrentDb
Set rstbl1 = dbs.OpenRecordset(wrktbl1, dbOpenTable)
Set rstbl2 = dbs.OpenRecordset(wrktbl1 & " BH", dbOpenTable)
rstbl2.MoveFirst
'If Then
If eventObj.EventType = PARTIAL_RESPONSE Or eventObj.EventType = RESPONSE Then
Dim it As blpapicomLib.MessageIterator
Set it = eventObj.CreateMessageIterator()
Do While it.Next()
Dim msg As Message
Set msg = it.Message
Dim numSecurities As Integer
numSecurities = msg.GetElement("securityData").NumValues
Dim i As Integer
rstbl1.Index = "PrimaryKey"
For i = 0 To numSecurities - 1
Dim Security As Element
Set Security = msg.GetElement("securityData").GetValue(i)
rstbl1.Seek "=", Left(Security.GetElement("security").Value, 9)
Dim fields As Element
Set fields = Security.GetElement("fieldData")
Dim a As Integer
Dim numFields As Integer
numFields = fields.NumElements
If Not rstbl1.NoMatch Then
For a = 0 To numFields - 1
'If IsNull(rstbl1) Then
Set rstbl1 = dbs.OpenRecordset(wrktbl1, dbOpenTable)
rstbl1.Index = "PrimaryKey"
rstbl1.Seek "=", Left(Security.GetElement("security").Value, 9)
'End If
Dim field As Element
Set field = fields.GetElement(a)
X = 1
found = False
Do Until found
If StrComp(field.Name, rstbl2.fields(X).Value, vbTextCompare) = 0 Then
found = True
Else
X = X + 1
End If
Loop
rstbl1.Edit
rstbl1.fields(X).Value = field.Value <-- Error occurs here.
rstbl1.Update
rstbl1.Close
Set rstbl1 = Nothing
Next
End If
Next
Loop
End If
'End If
Exit Sub
errHandler:
Dim errmsg As Variant
errmsg = Err.Description
MsgBox errmsg
rstbl2.Close
Set eventObj = Nothing
Set dbs = Nothing
Set rstbl1 = Nothing
Set rstbl2 = Nothing
End Sub
I should mention that I tried to minimze the un-updated data by clearing out the object after each field update. Trying to do it all at once (updating each field before running the .update) ends with the same error after 5 field updates.