Probleme mit WithEvents
15.03.2020 00:39:59
Marc
ich habe da mal wieder einen Fall bei dem ich zu keinem Ergebnis komme und ich hoffe hier kann mir jemand helfen. Ich ziehe mit folgendem Code Tickersymbole und Fundamentaldaten von der Traderworkstation von interactive Brokers.
Zunächst instanziere ich ein Objekt eines Klassenmoduls durch betätigen einer Schaltfläche:
Sub InitTWSControl()
Set ObjTWSControl = New Klasse1
End Sub
Im Klassenmodul wird bei Auslösen eines Events eine öffentliche Objektvariable deklariert, die sich auf eine Klasse bezieht.
Public WithEvents m_TWSControl As TWSLib.Tws
Im Klassenmodul befindet sich außerdem der folgende Code, der bei Initialisierung des Objekts ObjTWSControl eine Instanz der Klasse m_TWSControl erstellt:
Private Sub Class_Initialize()
Set m_TWSControl = New TWSLib.Tws
MsgBox "TWS initialisiert!"
End Sub
In einem Modul rufe ich nun eine Methode der Klasse m_TWSControl auf:
Call ObjTWSControl.m_TWSControl.reqMatchingSymbols(id, TickerSymbol)
Im Klassenmodul wird das Event abgefangen und ein Array gefüllt mit den empfangenen Daten:
Private Sub m_TWSControl_symbolSamples(ByVal reqId As Long, ByVal contractDescriptions As _
TWSLib.IContractDescriptionList)
' Array für Listbox füllen
Dim cd As TWSLib.ComContractDescription
Dim derivateTypes As String
Dim i As Long
Dim J As Long
For i = 0 To contractDescriptions.Count - 1
Set cd = contractDescriptions.Item(i)
ReDim Preserve vArray(5, i)
vArray(0, i) = contractDescriptions.Item(i).contract.conId
vArray(1, i) = contractDescriptions.Item(i).contract.Symbol
vArray(2, i) = contractDescriptions.Item(i).contract.secType
vArray(3, i) = contractDescriptions.Item(i).contract.primaryExchange
vArray(4, i) = contractDescriptions.Item(i).contract.currency
derivateTypes = ""
For J = 0 To cd.DerivativeSecTypes.Count - 1
derivateTypes = derivateTypes & cd.DerivativeSecTypes.Item(J) & Space(1)
Next J
vArray(5, i) = derivateTypes
Next i
' Array transponieren für Format der Listbox
ReDim tArray(contractDescriptions.Count - 1, 5)
For i = 0 To contractDescriptions.Count - 1
tArray(i, 0) = vArray(0, i)
tArray(i, 0) = Trim(tArray(i, 0))
tArray(i, 0) = CStr(tArray(i, 0))
tArray(i, 1) = vArray(1, i)
tArray(i, 2) = vArray(2, i)
tArray(i, 3) = vArray(3, i)
tArray(i, 4) = vArray(4, i)
tArray(i, 5) = vArray(5, i)
tArray(i, 5) = Replace(tArray(i, 5), " ", ",")
Next i
End Sub
So weit funktioniert das im Grunde auch. Allerdings gibt es immer wieder Momente in denen WithEvents nicht ausgelöst wird und das Array entweder die Information der letzten Abfrage beinhaltet oder leer bleibt und somit beim Erzeugen der dafür vorgesehen Listbox natürlich ein Fehler auftritt. Das sagt mir, dass in diesem Moment keine Instanz der Klasse1 mehr aktiv ist. In der Regel ist es auch so, dass die erste Abfrage nach dem öffnen des Workbooks grundsätzlich einen Fehler erzeugt und das Array bzw. die Listbox nicht generiert werden kann weil keine Daten vorliegen bzw. weil WithEvents nicht gegriffen hat obwohl ich eine Instanz des Klassenmoduls erzeugt habe und verbunden bin. Ich habe einen Haltepunkt im Klassenmodul platziert und sehe daher ob WithEvents greift.
Damit der Code zuverlässig funktioniert muss ich nach jeder Abfrage die Verbindung kappen mit der entsprechenden Methode der Klasse m_TWSControl, erneut ein neue Instanz der Klasse1 erzeugen und mich wieder verbinden.
Wenn ich die Listbox nach Erhalt der Daten einfach schließe und einen neuen Call durchführe funktioniert das seltsamerweise so oft ich will aber sobald ich den Code weiterlaufen lasse und mir weitere Daten ziehe mit dem Code, der unten steht, kann ich den ersten Call für die Symbol Samples nicht mehr wiederholen ohne die Verbindung zu trennen und die Klasse1 neu zu instanzieren.
Der auf den ersten Call folgende zweite Call wird aus einem Userfrom ausgeführt:
Call ObjTWSControl.m_TWSControl.reqFundamentalData(FundID, ObjTWSControl.m_contractInfo, fs)
Und der Erhalt der Daten wird wieder durch WithEvents im Klassenmodul vollzogen:
Private Sub m_TWSControl_fundamentalData(ByVal reqId As Long, ByVal data As String)
Dim xmlDoc As Object
Set xmlDoc = CreateObject("Microsoft.XMLDom") 'XMLDocument Object erstellen
xmlDoc.LoadXML (data)
On Error Resume Next
Sheets("KPI´s").Cells.Clear
ThisWorkbook.Worksheets("KPI´s").Cells(1, 1).Value = "Jahr"
ThisWorkbook.Worksheets("KPI´s").Cells(1, 2).Value = "Ertragsgröße"
ThisWorkbook.Worksheets("KPI´s").Cells(1, 3).Value = "Sondereffekte"
ThisWorkbook.Worksheets("KPI´s").Cells(1, 4).Value = "Bereinigt"
ThisWorkbook.Worksheets("KPI´s").Cells(1, 5).Value = "Aktien"
ThisWorkbook.Worksheets("KPI´s").Cells(1, 6).Value = "per Share"
Dim fYears As Object '
Dim Period As Object
Dim attrColl As Object
Dim kpiColl As Object
Dim kpi As Object
Dim kpiSheet As Object
Dim Line As Integer
Dim dblRound As Double
Line = 1
Set kpiSheet = ThisWorkbook.Worksheets("KPI´s")
Set fYears = xmlDoc.getElementsByTagName("FiscalPeriod")
For Each Period In fYears
Line = Line + 1
If Period.getAttribute("Type") = "Annual" Then
Set attrColl = Period.Attributes
If Line = 2 Then FiscalDate = attrColl.Item(1).Value ' Fiskaljahresende in Variable schreiben
kpiSheet.Cells(Line, 1).Value = attrColl.Item(2).Value
Set kpiColl = Period.getElementsByTagName("lineItem")
For Each kpi In kpiColl
If kpi.getAttribute("coaCode") = Rev Then
kpiSheet.Cells(Line, 2).Value = kpi.Text
ElseIf kpi.getAttribute("coaCode") = "SUIE" Then ' Sondereffekte
kpiSheet.Cells(Line, 3).Value = kpi.Text
ElseIf kpi.getAttribute("coaCode") = "SDWS" Then ' Diluted weighted average Shares
kpiSheet.Cells(Line, 5).Value = kpi.Text
End If
Next kpi
Else
End If
If Line Kann mir jemand sagen weshalb die Instanz des Klassenmoduls jedes mal gelöscht wird nachdem ich den Call für die Fundamentaldaten erfolgreich durchgeführt habe?
Woran kann es allgemein liegen wenn eine aktive Instanz eines Klassenmoduls gelöscht wird?
Viele Grüße,
Marc