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

Question

我正在尝试比较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

然后我可以成功完成主循环，并收到“完成”消息。但我一直无法缩小为什么第二个循环没有正确完成，而且我被卡住了。

Answer 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

---

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