MS Access VBA 循环停止，没有错误或明显原因答案

【问题标题】：MS Access VBA loop stops without error or apparent causeMS Access VBA 循环停止，没有错误或明显原因
【发布时间】：2019-07-06 08:45:20
【问题描述】：

我正在尝试比较 MS Access 中的两个数据数组 - 一个是从 API GET 生成的，另一个是从表的两列生成的。我正在使用双循环进行比较，我怀疑这不是最好的方法，但我仍在学习循环和数组的方法。我使用的代码如下：

Sub ParseList(ResCount As Long)

Dim db As DAO.Database
Dim rstConts As DAO.Recordset

Dim midstr As String, emailstr As String, Fname As String, Lname As String, SubStatus As String, echeck As String, Mecheck As String, ArrEcheck As String, ArrMecheck As String, MSub As String

Dim ArrResp() As String
Dim ArrConts() As Variant

Dim SubStart As Long, SubCount As Long, Fstart As Long, Fcount As Long, Lstart As Long, LCount As Long, Diffcount As Long, c As Long, i As Long, t As Long, y As Long, u As Long, v As Long

Dim IsSub As Boolean

Set db = CurrentDb
Udate = SQLDate(Now)

ReDim ArrResp(1 To ResCount, 1 To 4) As String

'This section parses a JSON response into an array
For i = 1 To ResCount
    midstr = ""
    emailstr = ""
    x = InStr(t + 2, GetListStr, "}}") + 21
    y = InStr(x + 1, GetListStr, "}}")
    If y = 0 Then
        Exit Sub
    End If
    midstr = Mid(GetListStr, x, y - x)
    emailstr = Left(midstr, InStr(midstr, ",") - 2)

    SubStart = InStr(midstr, "Status") + 9
    SubCount = InStr(InStr(midstr, "Status") + 8, midstr, ",") - SubStart - 1
    SubStatus = Replace(Mid(midstr, SubStart, SubCount), "'", "''")

    Fstart = InStr(midstr, ":{") + 11
    Fcount = InStr(InStr(midstr, ":{") + 11, midstr, ",") - (Fstart + 1)
    Fname = Replace(Mid(midstr, Fstart, Fcount), "'", "''")

    Lstart = InStr(midstr, "LNAME") + 8
    LCount = InStr(InStr(midstr, "LNAME") + 8, midstr, ",") - (Lstart + 1)
    Lname = Replace(Mid(midstr, Lstart, LCount), "'", "''")

    If SubStatus = "subscribed" Then
        MSub = "True"
        Else
        MSub = "False"
    End If

    ArrResp(i, 1) = emailstr
    ArrResp(i, 2) = MSub
    ArrResp(i, 3) = Fname
    ArrResp(i, 4) = Lname

    t = y
Next i

'This section grabs two columns from a database table and adds them to a second array
Set rstConts = CurrentDb.OpenRecordset("SELECT Primary_Email, EMailings FROM TBLContacts")
rstConts.MoveLast
rstConts.MoveFirst
c = rstConts.RecordCount

ReDim ArrConts(1 To c) As Variant
ArrConts = rstConts.GetRows(c)

'This loops through the JSON response array, and when it finds a matching value in the Table array it checks if a second value in the table array matches or not
For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)
    For v = 0 To c
        If ArrConts(0, v) = "" Then
            Else
            ArrEcheck = ArrConts(0, v)
            ArrMecheck = ArrConts(1, v)
            If ArrEcheck = echeck Then
                If ArrMecheck = Mecheck Then
                    Debug.Print echeck & "Match"
                    Else
                    Debug.Print echeck & "No Match"
                End If
            End If
        End If
    Next v
Next u

MsgBox "Done"

End Sub

上面的代码根本没有完成，并且 msgbox 永远不会显示。接近尾声的 debug.print 行只到 1，我不知道为什么。如果我从第二个循环部分中删除条件：

If ArrConts(0, v) = "" Then
Else
    ArrEcheck = ArrConts(0, v)
    ArrMecheck = ArrConts(1, v)
    If ArrEcheck = echeck Then
        If ArrMecheck = Mecheck Then
            Debug.Print echeck & "Match"
            Else
            Debug.Print echeck & "No Match"
        End If
    End If
End If

然后我可以成功完成主循环，并收到“完成”消息。但是我一直无法确定第二个循环没有正确完成的原因，我被卡住了。

【问题讨论】：

这是在 Access 中吗？您可以在 SQL 语句中使用 JSON 响应数组吗？ Join 将加入数组，所以你可以说where field in (" & join(arrJson,",") & ")"
您是否单步 (F8) 通过您的代码？如果数据很大，您可以生成其中的一小部分并单步执行吗？
这是在 Access 中 - @Nathan_Sav 你能扩展这个加入选项吗？我以前没有遇到过。我试过用 F8 但它不起作用，这很奇怪。
是的，我在帖子里有，所以如果你的 JSON 数组包含“Lookup1”、“lookup2”、“Lookup3”，那么你想让它成为 SQL where 条件，所以你可以说select * from table where field in (" & join(arrJSON,",") & ")" 会给你select * from table where field in ("Lookup1","lookup2","Lookup3")
请用proper error handling 包装您的整个处理过程，因为应该提出一个消息。

标签： arrays loops ms-access vba

【解决方案1】：

由于数组是零索引的，因此您需要从嵌套的For 循环的上限中减去 1，当循环超出记录限制时，该循环应该会在后续的If 行上引发错误。

For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)

    For v = 0 To c - 1                  ' REDUCE UPPER LIMIT BY 1
       If ArrConts(0, v) = "" Then      ' LINE NO LONGER SHOULD ERR OUT
       ...
    Next v
Next u

话虽如此，请考虑使用VBA-JSON library 将parsing JSON 用于MS Access 表。然后在表到表之间的基于集合的处理中，使用 SQL 来检查 JOIN 和 WHERE 的值。这比在数组之间循环要高效得多。

【讨论】：