Wie kann ich eine Sammlung von Wörterbüchern in VBA erstellen?

Question

Ich versuche, eine Sammlung von Wörterbüchern in VBA aufzubauen. Nachdem die Sammlung erstellt wurde, wird sie in JSON konvertiert und in einer HTTP-Anforderung an einen Webdienst gesendet.

Da Wörterbücher Objekte sind, werden sie der Sammlung durch Verweis hinzugefügt, nicht nach Wert. Das Ergebnis ist, dass meine Sammlung aus identischen Wörterbüchern besteht und nicht aus den einzelnen Wörterbüchern, die ich wollte.

Dim qdf As DAO.QueryDef 
Dim rs As DAO.Recordset 

Set qdf = CurrentDb.QueryDefs("qryTutors") 
Set rs = qdf.OpenRecordset 

Dim tutors As New Collection 

If Not (rs.EOF And rs.BOF) Then 
    Do Until rs.EOF = True 
     Dim tutor As New Scripting.Dictionary 
     tutor.Add "TutorName", rs!TutorFirstName.Value & " " & rs!TutorSurname.Value 
     tutor.Add "TutorEmail", rs!TutorEmail.Value 
     tutor.Add "TutorSubject", rs!TutorSubject.Value 
     tutors.Add tutor 
     tutor.RemoveAll 
     rs.MoveNext 
    Loop 
End If 

txtOutput.Value = JsonConverter.ConvertToJson(tutors) 

rs.Close 'Close the recordset 
Set rs = Nothing 'Clean up 

Jede Hilfe geschätzt, danke.

Answer 1

Verwenden Sie ein neues Wörterbuch in jeder Iteration:

Dim qdf As DAO.QueryDef 
Dim rs As DAO.Recordset 

Set qdf = CurrentDb.QueryDefs("qryTutors") 
Set rs = qdf.OpenRecordset 

Dim tutors As New Collection 
Dim tutor As Scripting.Dictionary 

If Not (rs.EOF And rs.BOF) Then 
    Do Until rs.EOF = True 
     Set tutor = New Scripting.Dictionary 
     tutor.Add "TutorName", rs!TutorFirstName.Value & " " & rs!TutorSurname.Value 
     tutor.Add "TutorEmail", rs!TutorEmail.Value 
     tutor.Add "TutorSubject", rs!TutorSubject.Value 
     tutors.Add tutor 
     rs.MoveNext 
    Loop 
End If 

txtOutput.Value = JsonConverter.ConvertToJson(tutors) 

rs.Close 'Close the recordset 
Set rs = Nothing 'Clean up