[函数]在两个字段完全相同的表中复制记录

fan0217

Public Function CopyRecord(ByVal strSource As String, ByVal strTarget As String, _
                                            ByVal DelRecord As Boolean)
'====================================================================
' 名称:        CopyRecord
' 作用:        在两个字段完全相同的表中复制记录
' 参数说明:    1.strSource:记录来源表的名称
'              2.strTarget:目标表的名称
'              3.DelRecord:复制后是否删除原记录，True为删除，False为保留
' 作者:        fan0217@163.com
' 日期:        2006-2-26
' 注释:
'
'====================================================================
On Error GoTo Err_CopyRecord

Dim conn As New ADODB.Connection
Dim rsSour As New ADODB.Recordset
Dim rsTar As New ADODB.Recordset

Dim i As Integer

Set conn = CurrentProject.Connection

rsSour.Open strSource, conn, adOpenKeyset, adLockOptimistic
rsTar.Open strTarget, conn, adOpenKeyset, adLockOptimistic

Do Until rsSour.EOF
    rsTar.AddNew
   
   For i = 0 To rsSour.Fields.Count - 1
       rsTar.Fields(i) = rsSour.Fields(i)
   Next
      
    rsTar.Update
        
   If DelRecord = True Then
        rsSour.Delete
   End If
    rsSour.MoveNext
Loop

Exit_CopyRecord:
    Exit Function

Err_CopyRecord:
    MsgBox Err.Description
    Resume Exit_CopyRecord
End Function

[此贴子已经被作者于2006-2-26 17:03:18编辑过]

skylark

To Fan0217:

收到,感谢其享.

shable

Download 了
先学学  谢了！

yanwei82123300

收到,感谢其享.