Office中国论坛/Access中国论坛

标题: [函数]在两个字段完全相同的表中复制记录 [打印本页]

作者: fan0217 时间: 2006-2-27 00:03
标题: [函数]在两个字段完全相同的表中复制记录
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
[attach]16033[/attach]

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

作者: skylark 时间: 2006-2-27 05:01
To Fan0217:

收到,感谢其享.

作者: shable 时间: 2006-2-28 18:50
Download 了
先学学谢了！

作者: yanwei82123300 时间: 2009-7-30 14:10
收到,感谢其享.

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)