将数组加载到记录集中以循环访问以增加值vba access

时间:2017-06-08 21:43:28

标签: vba ms-access access-vba

我正在尝试将访问数据库的两个表(与VBA代码在同一个数据库文件中)中的值加载到数组中以循环访问并在PART FIND NO与之前的PART FIND匹配时增加EQP_POS_CD字段中的值没有。查询:

SELECT CTOL.ID, CTOL.BOM_PART_NAME, CTOL.CII, CTOL.[PART FIND NO], CTOL.CSN,
       CTOL.AFS, CTOL.EQP_POS_CD, CTOL.LCN, CTOL.POS_CT, CTOL.SERIAL_NO, 
       CTOL.PART_NO_LLP, [CTOL_Asbuilt].[PART-SN], [CTOL_Asbuilt].[PART-ATA-NO], 
       [CTOL_Asbuilt].[PW-PART-NO]
FROM CTOL LEFT JOIN [CTOL_Asbuilt] ON CTOL.[PART FIND NO] = [CTOL_Asbuilt].[PART-ATA-NO];

代码:

Option Compare Database
Option Explicit




'Const adOpenStatic = 3
'Const adLockOptimistic = 3

Function queryDatabase()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As QueryDef
'Dim rsQuery As DAO.Recordset
Dim rows As Variant


Dim part_find_no() As String
Dim eqp_pos_no() As Integer
'Dim strSQL As String

Dim i As Integer
Dim j As Integer
'Set objConnection = CurrentDb.OpenRecordset("CTOL")

Set db = CurrentDb

Set qdf = db.QueryDefs("SicrProcess")

Set rs = qdf.OpenRecordset(dbOpenDynaset)

If rs.EOF Then GoTo Leave
rs.MoveLast
rs.MoveFirst


For i = 0 To rs.RecordCount
    part_find_no() = rs("PART FIND NO")
    eqp_pos_no() = rs("EQP_POS_CD")
    If part_find_no(i) = part_find_no(i - 1) Then
        eqp_pos_no(i) = eqp_pos_no(i) + 1
    End If
    Debug.Print rs.Fields("PART FIND NO") & " " & rs.Fields("EQP_POS_CD")
    rs.MoveNext
Next i

Leave:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    qdf.Close
    Set qdf = Nothing
    Set db = Nothing
    db.Close
    On Error GoTo 0
    Exit Function

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function

我不确定这里有什么问题。它期待数组,但我必须以某种方式初始化这些数组吗?如何根据查询生成的结果将这些字段设置为数组?我希望数组加载来自该查询的结果,但只是那些字段:PART FIND NO和EQP_POS_CD。然后它应循环遍历两个字段中的行,以在当前PART FIND NO与前一个PART FIND NO相同时递增EQP_POS_CD。关于如何清理它的任何建议?感谢。

1 个答案:

答案 0 :(得分:1)

我认为不需要数组对象。考虑:

Sub SetSeq()

Dim rs As DAO.Recordset, x As Integer, strPart As String, intSeq As Integer
Set rs = CurrentDb.OpenRecordset("SELECT [Part Find No], EQP_POS_CD FROM CTOL ORDER BY [Part Find No], SERIAL_NO;")

If rs.EOF Then GoTo Leave

rs.MoveLast
rs.MoveFirst
strPart = rs![Part Find No]
For x = 1 To rs.RecordCount
    If rs![Part Find No] <> strPart Then
        intSeq = 0
        strPart = rs![Part Find No]
    End If
    intSeq = intSeq + 1
    rs.Edit
    rs!EQP_POS_CD = intSeq
    rs.Update
    rs.MoveNext
Next x

Leave:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    On Error GoTo 0
    Exit Sub

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub

运行代码后的表:

+------------+--------------+-----------+
| EQP_POS_CD | Part Find No | SERIAL_NO |
+------------+--------------+-----------+
|          1 | a            | abc1      |
|          2 | a            | abc2      |
|          3 | a            | abc3      |
|          1 | b            | abc4      |
|          2 | b            | abc5      |
|          1 | c            | abc6      |
|          2 | c            | abc7      |
|          3 | c            | abc8      |
+------------+--------------+-----------+