示例

 

 

Public Sub MoveRecord(ByVal TableName As String, ByVal KeyName As String, _
               ByVal CurrentKey As Long, ByVal orientation As Integer, ByVal FormName As String)
    '功能：移动记录位置
    '参数：TableName -- 数据表名称
    '      KeyName -- 主键名称（主键应为自动编号类型）
    '      Currentkey -- 窗体中主键当前值
    '      orientation -- 移动方向（0=向前，1=向后）
    '      FormName -- 窗体名称
   
    Dim rs As New ADODB.Recordset
    Dim ssql As String
    Dim i As Long
    Dim val0(), val1()
    ssql = "select * from " & TableName
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.Find (KeyName & "=" & CurrentKey)
    ReDim val0(rs.Fields.Count - 1)
    ReDim val1(rs.Fields.Count - 1)
    For i = 1 To UBound(val0)
        val0(i) = rs.Fields(i).Value
    Next
    If orientation = 0 Then
        '前移
        rs.MovePrevious
        If rs.BOF = False Then
            For i = 1 To UBound(val0)
                val1(i) = rs.Fields(i).Value
                rs.Fields(i).Value = val0(i)
            Next
            rs.MoveNext
            For i = 1 To UBound(val0)
                rs.Fields(i).Value = val1(i)
            Next
            rs.Update
        End If
    Else
        '后移
        rs.MoveNext
        If rs.EOF = False Then
            For i = 1 To UBound(val0)
                val1(i) = rs.Fields(i).Value
                rs.Fields(i).Value = val0(i)
            Next
            rs.MovePrevious
            For i = 1 To UBound(val0)
                rs.Fields(i).Value = val1(i)
            Next
            rs.Update
        End If
    End If
    Forms(FormName).Refresh
    rs.Clone: Set rs = Nothing
End Sub

 

Public Sub InsetRecord(ByVal TableName As String, ByVal KeyName As String, _
               ByVal CurrentKey As Long, ByVal orientation As Integer, ByVal FormName As String)
    '功能：插入空白记录
    '参数：TableName -- 数据表名称
    '      KeyName -- 主键名称（主键应为自动编号类型）
    '      Currentkey -- 窗体中主键当前值
    '      orientation -- 插入方向（0=向前，1=向后）
    '      FormName -- 窗体名称
    Dim rs As New ADODB.Recordset
    Dim ssql As String
    Dim id As Long
    ssql = "select * from " & TableName
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.AddNew
    rs.Update
    id = rs.Fields(KeyName).Value
    '前插
    Do While rs.Fields(KeyName).Value <> CurrentKey
        If rs.BOF = True Then Exit Do
        Call MoveRecord(TableName, KeyName, id, 0, FormName)
        rs.MovePrevious
        id = rs.Fields(KeyName).Value
    Loop
       
    If orientation = 1 Then
        '后插
        Call MoveRecord(TableName, KeyName, CurrentKey, 1, FormName)
    End If
    Forms(FormName).Requery
    rs.Clone: Set rs = Nothing
End Sub