如何在VBA中创建字典集合?

时间:2017-11-10 11:19:53

标签: vba ms-access dictionary access-vba

我试图在VBA中建立一个字典集合。构建集合后,它将转换为JSON,并在HTTP请求中发送到Web服务。

因为词典是对象,所以它们是通过引用而不是通过引用添加到集合中的。结果是我的收藏品由相同的词典组成,而不是我想要的单个词典。

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

感谢任何帮助,谢谢。

1 个答案:

答案 0 :(得分:3)

在每次迭代中使用新词典:

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