Public Function fnCopyRecordMasterChild( _
ByVal SourceMaster As String, _
ByVal SourceChild As String, _
ByVal SourceMasterPKName As String, _
ByVal SourceChildKFName As String, _
ByVal SourceMasterPKValue As Variant, _
ByVal TargetMaster As String, _
ByVal TargetChild As String, _
ByVal TargetMasterPKName As String, _
ByVal TargetChildFKName As String)
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim fd As DAO.field
Dim strFieldType As String
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim varNewPK As Variant
SourceMaster = Replace$(Replace$("[" & SourceMaster & "]", "[[", "["), "]]", "]")
SourceChild = Replace$(Replace$("[" & SourceChild & "]", "]]", "]"), "[[", "[")
SourceMasterPKName = Replace$(Replace$("[" & SourceMasterPKName & "]", "]]", "]"), "[[", "[")
SourceChildKFName = Replace$(Replace$("[" & SourceChildKFName & "]", "]]", "]"), "[[", "[")
TargetMaster = Replace$(Replace$("[" & TargetMaster & "]", "]]", "]"), "[[", "[")
TargetChild = Replace$(Replace$("[" & TargetChild & "]", "]]", "]"), "[[", "[")
Set db = CurrentDb
strFieldType = TypeName(SourceMasterPKValue)
'expect strFieldType to be either number or String
If strFieldType = "String" Then
strCriteria1 = SourceMasterPKName & " = '" & SourceMasterPKValue & "'"
strCriteria2 = SourceChildKFName & " = '" & SourceMasterPKValue & "'"
Else
strCriteria1 = SourceMasterPKName & " = " & SourceMasterPKValue
strCriteria2 = SourceChildKFName & " = " & SourceMasterPKValue
End If
Set rs1 = db.OpenRecordset( _
"select * from " & SourceMaster & " where " & strCriteria1 & ";", dbOpenSnapshot, dbReadOnly)
'since not all fieldname are the same
On Error Resume Next
With rs1
If Not (.BOF And .EOF) Then
.MoveFirst
Set rs2 = db.OpenRecordset( _
"select * from " & TargetMaster & " where (1=0);", dbOpenDynaset)
rs2.AddNew
For Each fd In .Fields
If fd.Attributes And dbAutoIncrField Then
'do nothing
Else
rs2(fd.Name) = fd.Value
Next
Next
rs2.Update
rs2.Bookmark = rs2.LastModified
varNewPK = rs2(TargetMasterPKName)
rs2.Close
End If
.Close
End With
Set rs1 = db.OpenRecordset("select * from " & SourceChild & " where " & strCriteria2 & ";", _
dbOpenSnapshot, dbReadOnly)
With rs1
If Not (.BOF And .EOF) Then
.MoveFirst
Set rs2 = db.OpenRecordset("select * from " & TargetChild & " where (1=0);", dbOpenDynaset)
Do Until .EOF
rs2.AddNew
rs2(TargetChildFKName) = varNewPK
For Each fd In .Fields
If fd.Attributes And dbAutoIncrField Then
Else
rs2(fd.Name) = fd.Value
End If
Next
rs2.Update
.MoveNext
Loop
rs2.Close
End If
.Close
End With
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Function