خطا در ایجاد کاربرگ جدید در اکسل توسط اکسس

[eb_1345]

3- اطلاعات چندین شرکت وارد میشه و بعضا بروز رسانی میشه بنابراین باید از ورود اطلاعات تکراری جلوگیری بشه

برای جلوگیری از ورود اطلاعات تکراری کد زیر به آخر کدهای روال ImportExcelData اضافه شد.

DoCmd.RunSQL "DELETE * FROM tblExcel WHERE tblExcel.code_rojo IN (SELECT V.code_rojo FROM tblExcel AS V INNER JOIN tblEtelate_peymankari AS N ON V.code_rojo = N.code_rojo);"

با استفاده از کد فوق دو جدول tblEtelate_peymankari و tblExcel در فیلد code_rojo با هم مقایسه میشن و اگر مقدار این فیلد در هر دو جدول با هم برابر بود اطلاعات مشترک در جدول tblExcel حذف میشه و اگه اطلاعاتی هم در اون وجود داشته باشه اطلاعات جدیدتریست که قبلا به جدول اصلی اکس اضافه نشده که در انتقال جدید باید به جدول tblEtelate_peymankari اضافه بشه
کدهای تابع AppendData هم بصورت زیر تغییر می کنه :

Private Sub btnAppend_ClickPublic Sub AppendData(MainTable As String, ExcelTable As String)

'On Error Resume Next

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

Dim RS1 As DAO.Recordset

Dim RS2 As DAO.Recordset

Call ImportExcelData

Set RS1 = CurrentDb.OpenRecordset(MainTable)

Set RS2 = CurrentDb.OpenRecordset(ExcelTable)

For Each Fld1 In RS1.Fields

   FldName = FldName & ", " & Fld1.Name

Next

For Each Fld2 In RS2.Fields

   Fld1Select = Fld1Select & "," & ExcelTable & "." & Fld2.Name

Next

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

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



DoCmd.SetWarnings False

StrSql = "INSERT INTO " & MainTable & " (" & FldName & ")SELECT " & Fld1Select & " FROM " & ExcelTable & ""

DoCmd.RunSQL StrSql

DoCmd.SetWarnings True

If DCount("*", "tblEtelate_peymankari", "") > 0 And DCount("*", "tblExcel", "") = 0 Then

    MsgBox " ÇØáÇÚÇÊ ÌÏíÏí ÈÑÇí ÇÖÇÝå ÔÏä æÌæÏ äÏÇÑÏ "

Else

    MsgBox ("ÇíÇä ÚãáíÇÊ ÇäÊÞÇá ÇØáÇÚÇÊ")

End If

RS1.Close

RS2.Close

Set RS1 = Nothing

Set RS2 = Nothing

End Sub