Önce çalışmanıza bir modül ekleyip aşağıdaki 2 prosedürü yapıştırın
Sub modRST_CopyRecords(rstSource As Recordset2, _
rstTarget As Recordset2, _
strNewKeyName As String, _
varNewKeyValue As Variant)
' Copies each record from sourceRST to targetRST
' also we need to add a value for the NewKeyName
' in the target recordset
Dim fldSource As Field2
Dim fldTarget As Field2
If rstSource.EOF Then Exit Sub
Do While Not rstSource.EOF
' copy a record
rstTarget.AddNew
For Each fldSource In rstSource.Fields
Select Case fldSource.Type
Case dbAttachment, dbComplexByte, dbComplexInteger, _
dbComplexLong, dbComplexSingle, dbComplexDouble, _
dbComplexGUID, dbComplexDecimal, _
dbComplexText
modRST_CopyComplexField fldSource, _
rstTarget(fldSource.Name)
Case Else
If fldSource.Expression <> "" Then
' calculated field so skip copy
Else
' simple data type
rstTarget(fldSource.Name) = fldSource.Value
End If
End Select
Next
rstTarget.Update
rstSource.MoveNext
Loop
End SubSub modRST_CopyComplexField(fldSource As Field2, _
fldTarget As Field2)
' copy a complex type field
Dim rstComplexSource As Recordset2
Dim rstComplexTarget As Recordset2
Dim fldComplexSource As Field2
Set rstComplexSource = fldSource.Value
Set rstComplexTarget = fldTarget.Value
If rstComplexSource.EOF Then
' no multiple values
rstComplexSource.Close
rstComplexTarget.Close
Exit Sub
End If
Do While Not rstComplexSource.EOF
rstComplexTarget.AddNew
For Each fldComplexSource In rstComplexSource.Fields
If fldSource.Type = dbAttachment Then
' don't copy any readonly fields
' fields to copy are FileData and FileName
If fldComplexSource.Name <> "FileFlags" And _
fldComplexSource.Name <> "FileURL" And _
fldComplexSource.Name <> "FileType" And _
fldComplexSource.Name <> "FileTimeStamp" Then
rstComplexTarget(fldComplexSource.Name) = fldComplexSource
End If
Else
' other multi-value fields
rstComplexTarget(fldComplexSource.Name) = fldComplexSource
End If
Next
rstComplexTarget.Update
rstComplexSource.MoveNext
Loop
rstComplexSource.Close
rstComplexTarget.Close
End SubOn Error GoTo Err_SAKLA_Click
Dim X, a, B
If IsNull(Me.KLNO) Then
MsgBox "Lütfen Boş geçmeyin ,Klasör No'yu Yazmalısınız", 48, "Kayıt İşlemi"
Me.KLNO.SetFocus
Exit Sub
End If
If MsgBox("denetim saati girilmezse, diğer tüm alanlar girilse bile kayıt işlemi GERÇEKLEŞMEZ: Değişiklikler kaydedilsin mi?", 36, "K A Y D E T") = 6 Then
DoCmd.SetWarnings False
DoCmd.SetWarnings True
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.RunCommand acCmdSaveRecord
'hy_recordset2_MultiValuedFields____________________________________
CurrentDb.Execute " delete from tbl_kisiler WHERE tbl_kisiler.TCKIMLIKNO='" & Me.TCKIMLIKNO & "'"
Dim sOrGu, sOrGu2 As String
Dim rstKaynak As Recordset2
Dim rstHedef As Recordset2
sOrGu = " SELECT VERIGIRIS.KLNO, VERIGIRIS.TCKIMLIKNO, VERIGIRIS.ADISOYADI, VERIGIRIS.BASLAMATARIHI, " & _
" VERIGIRIS.geldimi, VERIGIRIS.SAVNO, BITISTARIHI, hangigun " & _
" FROM VERIGIRIS " & _
" WHERE VERIGIRIS.TCKIMLIKNO='" & Me.TCKIMLIKNO & "'"
sOrGu2 = " select KLNO, TCKIMLIKNO, ADISOYADI, BASLAMATARIHI, geldimi, SAVNO, BITISTARIHI, hangigun from tbl_kisiler " & _
" WHERE TCKIMLIKNO='" & Me.TCKIMLIKNO & "'"
Set rstKaynak = CurrentDb.OpenRecordset(sOrGu, dbOpenDynaset)
Set rstHedef = CurrentDb.OpenRecordset(sOrGu2, _
dbOpenDynaset)
modRST_CopyRecords rstKaynak, rstHedef, "TCKIMLIKNO", Me.TCKIMLIKNO
'hy_recordset2_MultiValuedFields____________________________________Bitti
Me.liste_1.Requery
Else
Me.Undo
End If
Exit_SAKLA_Click:
Exit Sub
Err_SAKLA_Click:
Resume Exit_SAKLA_Click
CokluAlan_MultiValuedField_hy2.rar
(Dosya Boyutu: 39,4 KB | İndirme Sayısı: 8)
((
