append کردن اطلاعات فیلدهای مشترک دو جدول متفاوت با کد

[moustafa]

با سلام
دو تا جدول متفاوت tbl1و tbl2 با فیلدهای مشترک داریم میخوائیم اطلاعات فیلدهای مشترک tbl1 رو بریزم تو tbl2 اونم یکبار و غیر تکراری حالا با استفاده از کدهای VBA یا SQL

[eb_1345]

با سلام
دو تا جدول متفاوت tbl1و tbl2 با فیلدهای مشترک داریم میخوائیم اطلاعات فیلدهای مشترک tbl1 رو بریزم تو tbl2 اونم یکبار و غیر تکراری حالا با استفاده از کدهای VBA یا SQL

سلام!
وقت بخیر !
فکر می کنم سوال شما مشابه سوالی باشه که در این تاپیک پرسیده شده . نمونه اصلاح شده پست 3 تاپیک رو بررسی بفرما !

[moustafa]

سلام!
وقت بخیر !
فکر می کنم سوال شما مشابه سوالی باشه که در این تاپیک پرسیده شده . نمونه اصلاح شده پست 3 تاپیک رو بررسی بفرما !

با عرض سلام و احترام جناب اقای بهرامی عزیز
عارضم که در برنامه فوق به فیلدها تک به تک اشاره شده و ما میدونیم که فیلدهای مشترک چی هست . در مورد من ممکنه جدول دوم دچار تغییرات بشه فیلد مشترک کمتر یا ساختارش عوض بشه اون موقع با کدهای شماها چون فیلد جدول اول در فیلد جدول دوم نیست الحاق صورت نمیگه وارور میده .مگر اینکه دستی فیلدی که حذف شده رو از کد حذف کنیم حالا اگه بالای ده تا جدول به این منظور داشته باشیم کار سخت و احتمال اشتباه زیاد و نیاز به زمان بیشتری است .
با تشکر

[eb_1345]

با عرض سلام و احترام جناب اقای بهرامی عزیز
عارضم که در برنامه فوق به فیلدها تک به تک اشاره شده و ما میدونیم که فیلدهای مشترک چی هست . در مورد من ممکنه جدول دوم دچار تغییرات بشه فیلد مشترک کمتر یا ساختارش عوض بشه اون موقع با کدهای شماها چون فیلد جدول اول در فیلد جدول دوم نیست الحاق صورت نمیگه وارور میده .مگر اینکه دستی فیلدی که حذف شده رو از کد حذف کنیم حالا اگه بالای ده تا جدول به این منظور داشته باشیم کار سخت و احتمال اشتباه زیاد و نیاز به زمان بیشتری است .
با تشکر

با سلام و احترام متقابل
در کدهای اصلاح شده نمونه ای که لینکشو در پست شماره 2 قرار داده ام ابتدا با استفاده از دوحلقه For Each فیلدهای دو جدول رو با هم مورد مقایسه قرار داده ام و در حلقه دوم این شرط رو بکار بردام که اگر نام فیلدهای جدول اول و دوم با هم برابر بودن نام فیلدهای مشترک رو پشت سرهم با استفاده از جداکننده , در متغییر رشته ای Fld1Name قرار بده . در واقع متغییر Fld1Name نام فیلدهای قسمت اول عبارت "INSERT INTO که در داخل پرانتز قرار میگیره برمیگردونه.
در همین قسمت شرط قسمت دوم عبارت "INSERT INTO بعد از پرانتز که با SELECT شروع و ترکیب نام جدول و فیلدها رو در متغییر رشته ای Fld1Select قرار داده ام و ترکیب این دو متغییر رو در متغییر رشته ای StrSql بکار برده ام و در نهایت با استفاده از دستور DoCmd.RunSQL مشخص کرده ام که کد اسکیول StrSql اجرا شود .
فعلا این کدها رو جایگزین کدهای نمونه لینک فوق کن ببین چه نتیجه ای حاصل میشه.
ان شاءالله به مرور با توجه به توضیحات بیشترتون و اینکه چه هدفی از انجام چنین کاری دارین کدها رو در صورت لزوم تغییر میدم تا نتیجه نهائی حاصل بشه.

Dim Fld1 As DAO.Field, Fld2 As DAO.Field

Dim Fld1Select As String

Dim StrSql As String

Dim Fld1Name As String

If DCount("*", "MainKala_tbl", "transferred=false") = 0 Then

   MsgBox "رکورد جديدي براي انتقال وجود ندارد "

   Exit Sub

End If

Dim RS1 As DAO.Recordset

Set RS1 = CurrentDb.OpenRecordset("MainKala_tbl")

Dim RS2 As DAO.Recordset

Set RS2 = CurrentDb.OpenRecordset("ChildKala_tbl")

For Each Fld1 In RS1.Fields

    For Each Fld2 In RS2.Fields

        If Fld2.Name = Fld1.Name Then

           Fld1Name = Fld1Name & ", " & Fld1.Name

           Fld1Select = Fld1Select & "," & "MainKala_tbl." & Fld1.Name

        End If

   Next

Next

Fld1Name = Right(Fld1Name, Len(Fld1Name) - 1)

Fld1Select = Right(Fld1Select, Len(Fld1Select) - 1)

DoCmd.SetWarnings False

StrSql = "INSERT INTO ChildKala_tbl (" & Fld1Name & ")SELECT " & Fld1Select & " FROM MainKala_tbl"

DoCmd.RunSQL "Update MainKala_tbl Set MainKala_tbl.transferred=true"

DoCmd.RunSQL StrSql

Me.ChildKala_sfrm.Requery

DoCmd.SetWarnings True

RS1.Close

RS2.Close

Set RS1 = Nothing

Set RS2 = Nothing

[eb_1345]

من ایندفعه کدهای بالا رو در یک تابع عمومی قرار دادم که بتونی نام جدول مبدا و مقصد رو انتخاب و در اون قرار بدی و با فراخوانی تابع عملیات انتقال رو انجام بدی

Public Sub AppendCommonFieldsData(SourceTable As String, TargetTable As String, FieldName As String)

'On Error Resume Next

Dim Fld1 As DAO.Field, Fld2 As DAO.Field, StrSql As String, FldName As String, Fld1Select As String

If DCount("*", "" & SourceTable & "", "" & FieldName & " = False") = 0 Then

   MsgBox "رکورد جديدي براي انتقال وجود ندارد "

   Exit Sub

End If

Dim RS1 As DAO.Recordset

Set RS1 = CurrentDb.OpenRecordset(SourceTable)

Dim RS2 As DAO.Recordset

Set RS2 = CurrentDb.OpenRecordset(TargetTable)

For Each Fld1 In RS1.Fields

    For Each Fld2 In RS2.Fields

        If Fld2.Name = Fld1.Name Then

           FldName = FldName & ", " & Fld1.Name

           Fld1Select = Fld1Select & "," & SourceTable & "." & Fld1.Name

        End If

    Next

Next

FldName = Right(FldName, Len(FldName) - 1)

Fld1Select = Right(Fld1Select, Len(Fld1Select) - 1)

DoCmd.SetWarnings False

StrSql = "INSERT INTO " & TargetTable & " (" & FldName & ")SELECT " & Fld1Select & " FROM " & SourceTable & " Where (" & SourceTable & "." & FieldName & "=false)"

DoCmd.RunSQL StrSql

DoCmd.RunSQL "Update " & SourceTable & " Set " & SourceTable & "." & FieldName & "=true Where " & SourceTable & "." & FieldName & "=false"

DoCmd.SetWarnings True

RS1.Close

RS2.Close

Set RS1 = Nothing

Set RS2 = Nothing

End Sub

[mazoolagh]

سلام و روز خوش

راه حل تمیز و موثری هست.

در حلقه دوم و بعد از

Fld1Select = Fld1Select & "," & SourceTable & "." & Fld1.Name

میشه یک exit for اضافه کنین.

پیشنهاد میکنم یک تاپیک جدید آموزشی برای UPSERT بسازین،
به این صورت که اگر رکورد قبلا در destination وجود داره ولی در source آپدیت شده، اونطرف هم آپدیت بشه،
و اگر رکورد جدید در source هست اونطرف insert بشه.

و این که نیازی به فیلد transferred هم نباشه!
چون ممکنه که این امکان نباشه.