انتقال خودکار اطلاعات از یک فایل اکسس مشابه دیگر

[fd110110]

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

[fd110110]

فایلهای نمونه که پیدا کردم
فقط من خودم خیلی کد نویسی بلد نیستم
اگر بشه که کدی نوشته بشه که اول همه جدولها را با یک نام اضافه مثل imp_tblname وارد کنه و بعد از روش فایل دوم برای آپدیت و اضافه کردن استفاده کنه خیلی عالی میشه!!!!

[fd110110]

یک مشکلی که بعضی از فایلها هم دارن استفاده از لایبرری اضافه هست که من خودم نتونستم نصب کنم یعنی وقتی توی رفرنس تیک میزنم میگه فایل dll موجود نیست

[mazoolagh]

سلام و روز خوش


فقط من خودم خیلی کد نویسی بلد نیستم
متاسفانه بدون این که خودتون مسلط باشین نمیشه (در عمل و در دنیای واقعی منظورم هست!)
این که یک ماجول یا برنامه پیدا کنین که خیلی کامل و بدون نیاز به تغییر باشه،
کاملا پارامتریک باشه و با هر جدولی با هر ساختاری کار کنه (انتخاب جدول و فیلدها و شرایط و ...)،
کاملا خودکار باشه و ...

یا باید سفارشی بدین براتون بنویسن (بهترین راه عملی هست بنظرم از نظر زمان و هزینه)
یا این که صبر کنین یک نفر با وقت آزاد از روی علاقه شخصی این کار رو انجام بده -
و امیدوار باشین که هم تخصص کافی داشته باشه و هم در آینده پشتیبانی کنه (واقعا بعید هست چنین موقعیتی).

ولی اگر خودتون کار رو دست بگیرین و برین جلو،
و مشکلات رو اینجا مطرح کنین (منظور مشکل ریز و دقیق و موردی هست و نه مثل این که مطرح کردین)،
در این صورت شانس خیلی خوبی دارین که نتیجه مناسب بگیرین.

[fd110110]

Option Compare Database


Sub ImportAndCompareTables()
Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim newTableName As String
Dim rsExisting As DAO.Recordset
Dim rsImported As DAO.Recordset
Dim strSQL As String
Dim fld As DAO.Field
Dim fd As FileDialog
Dim selectedFile As String

' Open the file dialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.title = "انتخاب فایل برای دریافت اطلاعات"
If .Show = -1 Then
selectedFile = .SelectedItems(1)
Else
Exit Sub
End If
End With

' Open the selected external database
Set db = OpenDatabase(selectedFile)

' Import each table from the external database
For Each tbl In db.TableDefs
' Ignore system tables
' If (tbl.Attributes And dbSystemObject) = 0 Then
If Not tbl.Name Like "MSys*" Then
' Generate a new table name
newTableName = "Imported_" & tbl.Name

' Check if the table already exists in the current database
If Not TableExists(newTableName) Then
' Create a new table with the imported table structure
DoCmd.TransferDatabase acImport, "Microsoft Access", selectedFile, acTable, tbl.Name, newTableName
End If

' Compare the existing and imported tables
'diff*****
If TableExists(newTableName) Then
If DCount("*", newTableName) > 0 Then
Set rsExisting = CurrentDb.OpenRecordset(tbl.Name)
Set rsImported = CurrentDb.OpenRecordset(newTableName)

While Not rsImported.EOF
' Check if the record already exists in the existing table
strSQL = "SELECT * FROM " & newTableName & " WHERE "
For Each fld In rsImported.Fields
strSQL = strSQL & fld.Name & " = " & ConvertToSQL(fld.Value) & " AND "
Next fld
strSQL = Left(strSQL, Len(strSQL) - 5)
If DCount("*", tbl.Name, strSQL) > 0 Then
rsExisting.FindFirst strSQL

If Not rsExisting.NoMatch Then
' Update the existing record
For Each fld In rsImported.Fields
rsExisting(fld.Name) = fld.Value
Next fld
rsExisting.Update
Else
' Add the record to the existing table
rsExisting.AddNew
For Each fld In rsImported.Fields
rsExisting(fld.Name) = fld.Value
Next fld
rsExisting.Update
End If

rsImported.MoveNext
Wend

rsExisting.Close
rsImported.Close
End If
' Delete the imported table
' DoCmd.DeleteObject acTable, newTableName
Next tbl

' Close the external database
db.Close
Set db = Nothing
End Sub


Function ConvertToSQL(ByVal vValue As Variant) As String
If IsNull(vValue) Then
ConvertToSQL = "NULL"
ElseIf VarType(vValue) = vbString Then
ConvertToSQL = "'" & Replace(vValue, "'", "''") & "'"
ElseIf VarType(vValue) = vbDate Then
ConvertToSQL = "#" & Format$(vValue, "yyyy\/mm\/dd hh\:nn\:ss") & "#"
Else
ConvertToSQL = vValue
End If
End Function


Function TableExists(ByVal tableName As String) As Boolean
Dim tdf As DAO.TableDef
Dim db As DAO.Database

Set db = CurrentDb()

For Each tdf In db.TableDefs
If tdf.Name = tableName Then
TableExists = True
Exit Function
End If
Next tdf

TableExists = False
End Function

[fd110110]

gpt
داده
به نظرم با یک کم اصلاح کار کنه

[simorgh2000]

سلام

این نمونه فایل را چک کنید.


دراین روش تغییرات باید توسط کاربران انجام بشه و مدیر فقط اطلاعات جداول را بازیابی میکنه .
لازم به ذکر است این روش فقط یک نمونه هست .