PDA

View Full Version : آموزش: فراخواني و import كردن جداول يك فايل اكسس به داخل برنامه با كد



abdoreza57
چهارشنبه 11 آبان 1390, 00:41 صبح
با سلام خدمت تمام دوستان و اساتيد محترم كه ساعات حضورشان و جوابدهي به كاربران باعث دلگرمي ماست


در صورتي كه در برنامه ايجاد شده تغييراتي در فرمها داده باشيم و بخواهيم اطلاعات قديمي موجود در table ها را جايگزين جداول كنوني نماييم با چه كدي مي توان اين كار را انجام داد
توضيح اينكه اين باتون را به علت بستن شيفت و آبگريد برنامه مي خواهم انجام دهم
يعني بدون ورود به ديتابيس و از طريق فرم اين كار را بكنم تا هم اطلاعات قبلي حفظ شده و هم فرمها به امكانات و طراحي جديد ارائه شوند
ممنونم كه لطف كرده و معايت يا محاسن اين كار را هم برام بگيد

Abbas Amiri
چهارشنبه 11 آبان 1390, 11:06 صبح
کد زیر را در ایونت Click مربوط به باتن کپی کنید


Private Sub Command60_Click()
Dim tbl As TableDef
Dim s As String
s = Me.RecordSource
Me.RecordSource = ""
Dim strSource As String
'strSource = "Full path of backup file"
strSource = CurrentProject.Path & "\old.mdb"
For Each tbl In CurrentDb.TableDefs
If tbl.Attributes = 0 Then ' for linked tables : tbl.Attributes = dbAttachedTable
DoCmd.DeleteObject acTable, tbl.Name
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strSource, acTable, tbl.Name, tbl.Name
End If
Next
Me.RecordSource = s
End Sub

abdoreza57
چهارشنبه 11 آبان 1390, 12:19 عصر
سلام
واقعا ممنون از سرعت عمل و پاسخگويي سريعت ممنون دقيقا هموني بود كه مي خواستم
خواهشي كه دارم اينه :
توضيحي در رابطه را معايب اين كار يا اصولا اين روش ازنظر شما درست هست يا خير ؟ بفرماييد
البته اگه وقتتون اجازه ميده

abdoreza57
چهارشنبه 11 آبان 1390, 15:36 عصر
با سلام
1 ) با اجراي كد فوق اولين مرحله عملياتي كه حذف كامل تيبل است رابطه relation sheep از بين مي رود بنابر اين به نظر ميرسه ايده مناسبي نباشه !
2 )replace كردن جدول را اگر بتوان به صورت كد انجام داد ايده مناسبي است چون در اين حال رابطه هاي موجود همچنان باقي مي مانند

Abbas Amiri
چهارشنبه 11 آبان 1390, 20:50 عصر
به این مورد برخوردنکرده بودم . خودم هم چیز تازه ای یادگرفتم این کد را در یک ماجول کپی کنید و از هرجا خواستید صداش بزنید البته شاید راه ساده تری هم وجودداشته باشد.


Public Type RecRelation
rName As String
rAttr As Integer
rTable As String
rFtable As String
rFieldName As String
rFieldForeign As String
End Type
Function ImportRecords()
Dim recRel() As RecRelation
Dim Rel As Relation, fld As Field
Dim relAttr() As Integer, k As Integer
Dim strSource As String
Dim tbl As TableDef
Dim s As String
strSource = CurrentProject.Path & "\old.mdb"
k = CurrentDb.Relations.Count
DoCmd.SetWarnings False
If k Then
k = k - 1
ReDim recRel(k)
For Each Rel In CurrentDb.Relations
recRel(k).rAttr = Rel.Attributes
recRel(k).rName = Rel.Name
recRel(k).rTable = Rel.Table
recRel(k).rFtable = Rel.ForeignTable
recRel(k).rFieldName = Rel.Fields(0).Name
recRel(k).rFieldForeign = Rel.Fields(0).ForeignName
CurrentDb.Relations.Delete Rel.Name
k = k + 1
Next Rel
End If
For Each tbl In CurrentDb.TableDefs
On Error Resume Next
If tbl.Attributes = 0 Then
strSQL = "DELETE * FROM " & tbl.Name
DoCmd.RunSQL strSQL
strSQL = "INSERT INTO " & tbl.Name & " SELECT * FROM " & tbl.Name & " IN '" & strSource & "'"
DoCmd.RunSQL strSQL
End If
Next
If k Then
For k = 0 To UBound(recRel)
Set Rel = CurrentDb.CreateRelation(recRel(k).rName, recRel(k).rTable, recRel(k).rFtable)
Set fld = Rel.CreateField(recRel(k).rFieldName)
fld.ForeignName = recRel(k).rFieldForeign
Rel.Fields.Append fld
CurrentDb.Relations.Append Rel
k = k + 1
Next
End If
DoCmd.SetWarnings True
End Function

abdoreza57
چهارشنبه 11 آبان 1390, 23:27 عصر
با سلام خدمت جناب اميري
احسنت به اين ظرافت كار
فقط لطف ميكردي و در مورد اين ايده بهم ميگفتي كه كلا شما اين روش را كار صحيحي مي دانيد يا خير و اصولا براي آبگريد كردن برنامه و اضافه كردن امكانات در فرمها و يا گزارشات راه مناسبي هست يا خير
در حد چند خط هم كفايت مي كرد اين فانكشن واقعا رهگشا بود

Abbas Amiri
چهارشنبه 11 آبان 1390, 23:34 عصر
فکر نکنم مشکلی داشته باشد، چون آزمایش نشده است تا چند وقت حتماقبل از اجرای کد بکاپ گیری کنید(قبل ازفراخوانی این کد یک کد مربوط به بکاپ را فراخوانی کنید) تامطمئن شوید.

abdoreza57
پنج شنبه 12 آبان 1390, 10:17 صبح
با سلام
ضمن سپاس بابت ماژولي كه تهيه نموديد به موارد مذكور اضافه ميشود
3) در صورتي كه روابط relation sheep بيش از يك رابطه باشد بقيه را تخريب مي نمايد نمي دونم تو كدوم قسمت فرمان اين محدوديت قرار داده شده است ولي لازم به اصلاح است
4) با همين فرمان
ImportRecords بقيه Tables هم مي بايست بروز شود ولي شايد بعلت مورد 3 احتملا اين دستور غير فعال مي شود اگه لازم ميدونيد نمونه ضميمه كنم
.
.
.

Abbas Amiri
پنج شنبه 12 آبان 1390, 19:02 عصر
با تغغیرات زیر باید درست شده باشد


Public Type RecRelation
rName As String
rAttr As Integer
rTable As String
rFtable As String
rFields As Fields
End Type
Function ImportRecords()
Dim recRel() As RecRelation
Dim Rel As Relation, fld As Field
Dim relAttr() As Integer, k As Integer
Dim strSource As String
Dim tbl As TableDef
Dim s As String
strSource = CurrentProject.Path & "\old.mdb"
k = CurrentDb.Relations.Count
DoCmd.SetWarnings False
If k Then
k = k - 1
ReDim recRel(k)
For Each Rel In CurrentDb.Relations
recRel(k).rAttr = Rel.Attributes
recRel(k).rName = Rel.Name
recRel(k).rTable = Rel.Table
recRel(k).rFtable = Rel.ForeignTable
Set recRel(k).rFields = Rel.Fields
CurrentDb.Relations.Delete Rel.Name
k = k + 1
Next Rel
End If
For Each tbl In CurrentDb.TableDefs
On Error Resume Next
If tbl.Attributes = 0 Then
strSQL = "DELETE * FROM " & tbl.Name
DoCmd.RunSQL strSQL
strSQL = "INSERT INTO " & tbl.Name & " SELECT * FROM " & tbl.Name & " IN '" & strSource & "'"
DoCmd.RunSQL strSQL
End If
Next
If k Then
For k = 0 To UBound(recRel)
Dim j As Integer
Set Rel = CurrentDb.CreateRelation(recRel(k).rName, recRel(k).rTable, recRel(k).rFtable)
For j = 0 To recRel(k).rFields.Count - 1
Set fld = Rel.CreateField(recRel(k).rFields(j).Name)
fld.ForeignName = recRel(k).rFields(j).ForeignName
Rel.Fields.Append fld
Next
CurrentDb.Relations.Append Rel
k = k + 1
Next
End If
DoCmd.SetWarnings True
End Function

abdoreza57
پنج شنبه 12 آبان 1390, 21:21 عصر
سلام
نه تغييري نكرد و تا قطع ارتباطها به پايان نرسه ارور ميده و سرانجام تو رابطه اول كه باقي ماند ركوردها را جايگزين ميكنه
منتظرم اگه برات زحمتي نيست دليلش زا پيدا كني

Abbas Amiri
پنج شنبه 12 آبان 1390, 23:47 عصر
اگر امکانش هست فقط چندتا ازتیبل های مورد نظرتان را بفرستید تا روی آنها چک کنم

abdoreza57
جمعه 13 آبان 1390, 00:18 صبح
با سلام
ابتدا روابط هر دو فايل را نگاه كن
سپس با كليك بر روي الصاق يكي يكي روابط از اين برنامه حذف مي شود !!!!
با كليك اول ارور Out of rangre داده در حالي كه يكي از روابط موجود را قطع نموده است به همين ترتيب تا آخر
كه حداقل يك رابطه بماند بعد روي يك تيبل عمل مي كند



در صورتي كه با توجه به فانكشن انتظار ميرفت كه تمام تيبل هاي متناظر و هم نام را replace نمايد بدون اين كه به relation ships تغييري ايجاد كند

Abbas Amiri
جمعه 13 آبان 1390, 01:12 صبح
این کد جدید رو امتحان کردم درست بود.


Option Compare Database
Public Type RecRelation
rName As String
rAttr As Integer
rTable As String
rFtable As String
rFields As Fields
End Type
Function ImportRecords()
Dim recRel() As RecRelation
Dim Rel As Relation, fld As Field
Dim k As Integer, j As Integer
Dim strSource As String
Dim tbl As TableDef
Dim s As String
strSource = CurrentProject.Path & "\old.mdb"
k = CurrentDb.Relations.Count
DoCmd.SetWarnings False
If k Then
k = k - 1
ReDim recRel(k)
k = 0
For Each Rel In CurrentDb.Relations
recRel(k).rAttr = Rel.Attributes
recRel(k).rName = Rel.Name
recRel(k).rTable = Rel.Table
recRel(k).rFtable = Rel.ForeignTable
p = Rel.Fields.Count
Set recRel(k).rFields = Rel.Fields
CurrentDb.Relations.Delete Rel.Name
k = k + 1
Next Rel
End If
'On Error Resume Next
For Each tbl In CurrentDb.TableDefs
If tbl.Attributes = 0 Then
' æÌæÏ ÌÏæá ÌÇÑí ÏÑ ãÈÏÇ ˜ ÔæÏ
If GetFieldVal("MSysObjects", "Count(*)", "Name = '" & tbl.Name & "' AND (Type = 1) ", strSource) Then
strSQL = "DELETE * FROM " & tbl.Name
DoCmd.RunSQL strSQL
strSQL = "INSERT INTO " & tbl.Name & " SELECT * FROM " & tbl.Name & " IN '" & strSource & "'"
DoCmd.RunSQL strSQL
End If
End If
Next
If k Then
'On Error GoTo 0
For k = 0 To UBound(recRel)
Set Rel = CurrentDb.CreateRelation(recRel(k).rName, recRel(k).rTable, recRel(k).rFtable, recRel(k).rAttr)
For j = 0 To recRel(k).rFields.Count - 1
Set fld = Rel.CreateField(recRel(k).rFields(j).Name)
fld.ForeignName = recRel(k).rFields(j).ForeignName
Rel.Fields.Append fld
Next
CurrentDb.Relations.Append Rel
Next
End If
DoCmd.SetWarnings True
End Function
Function GetFieldVal(tdf As String, fld As String, Optional Criteria As String = " (1) ", Optional SourceDb As String = "") As Variant
Dim rs As Recordset
Dim db As Database
Dim strSQL As String
If SourceDb <> "" Then
Set db = DBEngine.OpenDatabase(SourceDb)
Else
Set db = CurrentDb
End If
strSQL = "SELECT " & fld & " FROM " & tdf & " WHERE " & Criteria
Set rs = db.OpenRecordset(strSQL)
GetFieldVal = Nz(rs.Fields(0))
End Function

abdoreza57
جمعه 13 آبان 1390, 09:06 صبح
سلام


بي نهايت ممنون چند مورد و براي نمونه هاي ديگه هم امتحان كردم كاملا بي نقص كار مي كرد
اگه ميتوني براي يه مبتدي مثل من توضيح بدي كه كد بالا اصولا چه عملياتي روي تيبل ها انجام ميده ممنون ميشم
متن داخل فتكشن نا خوانا بود
لطفا توضيحات موجود را بفرماييد
'
æÌæÏ ÌÏæá ÌÇÑí ÏÑ ãÈÏÇ ˜ ÔæÏ در ضمن از لطفي كه نمودي ممنون

abdoreza57
جمعه 13 آبان 1390, 10:27 صبح
سلام
جناب اميري گل به موردي برخوردم كه لازم ميدونم به دوستاني كه قصد استفاه از اين فانكشن را دارند اطلاع بدم

در صورتي كه از اين كد براي به روز رساني برنامه هاي خود مي خواهيد استفاده كنيد :
اگر برنامه در دست اصلاح را نسخه نهايي و انچه از قبل استفاده ميشد قديمي بناميم


1) اضافه نمودن فيلد يا تيبل در فرم نهايي مجاز است
2) تعريف روابط يا تغيير relationships امكان پذير است
3) امكان حذف فيلدي از نمونه قديم در نمونه نهايي وجود ندارد بنابر اين شما ميبايست تمام فيلدهاي قديمي را در نهايي هم داشته باشيد
4) در صورت نبود فايل قديم در مقصد تمام روابط گسسته مي شود

مورد 3 و 4 با 3127 و run_time error 3024 مواجه ميشود كه دوستان دقت كنند در استفاده از برنامه دچار اشتباه نشوند

و اما جناب اميري ! به نظر شما ميشه كد برگردوندن اين فرامين را هم در فانكشن داشت كه در صورت محقق نبودن اين موارد از شروع عمليات جلوگيري به عمل بياد يا با همين موارد استفاده از آن را مجاز مي دانيد
بازم ممنون كه با صبر و حوصله به سوالات جواب ميديد

Abbas Amiri
جمعه 13 آبان 1390, 12:19 عصر
در توضیح ناخوانا نوشته بودم قبل از عملیات پاک کردن تیبل از وجود آن در جدول مبدا مطمئن شود.درغیر اینصورت به سراغ بعدی می رود.بنابراین تمام تیبل ها باقی می مانند + ریلیشن ها ، چراکه آنها کپی می شوند و پس از بروز رسانی تیبل ها مجددا ساخته می شوند. البته به سادگی با اضافه کردن یک فانکشن دیگر می توان تطابق دوجدول از نظر فیلدها راچک کردسپس اجازه حذف ودوباره لود کردن رکوردها راداد. اما بهر حال یک مقدار ریسک دارد

abdoreza57
جمعه 13 آبان 1390, 13:42 عصر
ممنون خيلي لطف كردي
ولي فكر ميكنم اصلاح نقص 4 لازم باشه چون در صورتي كه فايل مبدا را به همان نام ذخيره نكرده باشيم تمام روابط از بين مي رود بدون هيچ پيغامي

Abbas Amiri
جمعه 13 آبان 1390, 14:06 عصر
اگه به خط 38 دقت کنی میبینی که درصورت وجود تیبل در فایل مبدا، همنام تیبل فایل جاری عملیات پاک کردن تیبل وبارگذاری مجدد انجام خواهد شد . درضمن ریلیشن ها از فایل جاری ذخیره ، پاک و مجددا کپی میشوند

abdoreza57
شنبه 14 آبان 1390, 01:07 صبح
سلام منظورم فايل بو در
صورتي كه فايل مبدا را به همان نام ذخيره نكرده باشيم كه در صورت عدم وجود فايل (old)عمليات انجام مي شود ولي به شيوه اي كه گفتم

Abbas Amiri
شنبه 14 آبان 1390, 21:46 عصر
با اضافه کردن این دوخط کد بعد از تعیین مسیر فایل به منظورتان می رسید.


strSource = CurrentProject.Path & "\olds.mdb"
If Dir(strSource) = "" Then
MsgBox "فایل مورد نظر وجود ندارد"
Exit Sub
End If

abdoreza57
شنبه 14 آبان 1390, 22:44 عصر
سلام جناب اميري
متاسفانه اين كد رويه برگرودندن و لغو عمليات را انجام نميده
همينطور يه رويه شرطي قرار دادم كه درصورت وجود تیبل در فایل مبدا، همنام تیبل فایل جاری عملیات پاک کردن تیبل وبارگذاری مجدد انجام بشه در غير اين صورت انصراف عمليات كه متاسفانه كل ماژول به هم ريخت لطف كن اين دو تا دستور را هم تو محل خاصش قرار بده هم خودتون را خلاص كن هم ما را از سرگرداني نجات بده جناب اميري من از كد نويسي هيچ سردر نمي آرم فقط برخي آرگومانهاي اصلي را مي شناسم با كمي عمليات دستوري لذا به اين نكته توجه داشته باشيد

Abbas Amiri
شنبه 14 آبان 1390, 22:54 عصر
می خواهیداول تمام جدول ها چک شوند که در فایل OLD قراردارند وبعد عملیات شروع شود؟

abdoreza57
یک شنبه 15 آبان 1390, 01:05 صبح
بله
منتها در مورد شرط قرار دادن منظورمه كه درسته پيغام صادر ميشه ولي تا اون موقع عمليات انجام شده و ارتباط جداول به هم ميخوره يعني پاك ميشه

جسارتا به نظر ميرسه تو الگوريتمها تقدم و تاخر لحاظ نميشه

shervinrad
یک شنبه 15 آبان 1390, 16:35 عصر
سلام خدمت جناب امیری

دوست عزیز من هم همین مشکل رو دارم اگه زحمت بکشید روی این نمونه ای که براتون میزارم اصلاح بفرمایید ممنون میشم

سپاس

Abbas Amiri
یک شنبه 15 آبان 1390, 19:24 عصر
نمونه نهایی را گذاشتم این بحث خیلی بیشتر ازاین هم می تواند جلو برود ولی وقت هم مهم است.

abdoreza57
دوشنبه 16 آبان 1390, 21:03 عصر
سلام

اميري عزيز ضمن تشكر بابت زحمتي كه كشيديد و پوزش از وقفه اي كه پيش آمد

متاسفانه اين تاپيك به نتيجه دلخواه ايجاد كننده تاپيك نرسيد هز چند در مورد اين موضوع كه
ولی وقت هم مهم است. حق با شماست منتها اين جهت استفاده از زحماتتان و آموزش و راهكاري كه داديد مي بايست يك پروژه عملي ايجاد گردد

الاايحال تو نمونه 2003 هر كاري كردم عمل نكرد ضمن اينكه 2007 رو سيستم ندارم ولي كد فراخواني تو نمونه چي هست ؟
كمي اگر وقت اجازه ميده رو اين مسئله كار كنيد ممنون

Abbas Amiri
دوشنبه 16 آبان 1390, 22:03 عصر
این هم با فرمت mdb

abdoreza57
سه شنبه 17 آبان 1390, 17:28 عصر
سلام


بازم ممنون بابت اين همه زحمتي كه قبول كرديد وجدانا معركه بود و دمت گرم

جناب اميري تو اين نمونه فقط يه نقطه ضعف داره و اون هم اينه كه در صورت اضافه شدن تيبل يا ريليشن شيپ در فايل مقصد (كه طبيعي است در نسخه هاي بعدي ممكن است برنامه داراي امكانات جديدي گردد ) فرمان اجرا نمي شود


در پست 13 كد مورد نظر با اين شرايط اجرا مي شد ولي تو نمونه ارسالي قسمتي از فرمان ناديده گرفته شده است اگه براتون امكانش هست همين كد نمونه ارسالي را با اون مقايسه كنيد و اصلاح .
اگه اين ماژول به صورت عملي دربياد حتما گزارشش را بهتون ميدم كه چقدر مفيد واقع خواهد شد

Abbas Amiri
سه شنبه 17 آبان 1390, 18:46 عصر
فرمایش شما درست ، ولی اگرجدول ها مبدا در مقصد موجود نباشد اطلاعات جداول دیگر بازیابی می شوند وچنانچه جدول در فایل مقصد بازیابی نشود و دارای Relation باشد در هنگام Load کردن اطلاعات ممکن است کلید اصلی در جدولهای دیگر مقداردهی نشده باشد .درنتیجه Error خواهد داد. حالا اگر مشکلی بوجود نمی آیدآن را اصلاح خواهم کرد وفقط ازنظر تطابق فیلد آنها راچک میکنیم.

abdoreza57
سه شنبه 17 آبان 1390, 22:29 عصر
سلام

نه نه مشكل بوجود مي آيد همين مسئله شايد بتوان گفت مهمترين قسمت داستان باشد كه : حفظ روابطي(relaten) كه تو فايل مقصد بوجود آمده هدف بقايت است و فراخواني ديتاي تيبلهاي موجود در فايل مقصد هدف بعدي


آقاي اميري بايد عرض كنم من برنامه اي تهيه كرده ام كه در حال استفاده است شرايطي پيش آمد كه مجبور به تغيير شدم از جمله ايجاد جدوال جداگانه با روابط يك به چند يا يك به يك لذا كل برنامه تغيير يافت و براي انتقال اطلاعات قديمي به فايل مقصد راهي كه به نظرم ميرسيد اين بود كه جداول فايل قديم را ايمپرت كرده و replace نمايم و عملي هم بود لذا تصميم به اين ايجاد اين تاپيك نمودم و با زحمات جنابعالي كار تقريبا به آخر رسيد اما اصلاح اين مورد به نظر ميرسه نقطه پايان اين تاپيك 29 پستي (البته تا كنون) بشه


دوست خوبم اگر اين مطالب را درنظر بگيريم در وحله اول حفاظت از روابط مهم است و دوم ديتا بنابر اين با توضيحاتي كه شما داديد و منطقي است كه با حذف شدن جدول؛ كليد اوليه هم حذف و تا بازيابي؛ رابطه به هم مي خورد و تمام !!



لذا اگر راهكار ديگري به ذهنتان رسيد براي حداقل 200 نفر بازديد كننده اين تاپيك راهكارتان يك آموزش جامع و در حد كمال خواهد بود

Abbas Amiri
سه شنبه 17 آبان 1390, 23:12 عصر
و منطقي است كه با حذف شدن جدول؛ كليد اوليه هم حذف و تا بازيابي؛ رابطه به هم مي خورد و تمام

دوست عزیز ، مثل اینکه شما زیاد به عملکرد برنامه دقت نکردید. هیچ جدولی طی عملیات حذف نمی شود بلکه ابتدا اطلاعات آن پاک می شود وسپس با اطلاعات جدول مبدا بار می شود.علت اینکه مجبور به حذف روابط وایجاد دوباره آن شدم فقط به این دلیل بود که زمانی که جدولی پاک شده ومجددا درحال بارگذاری باشد ،چنانچه دارای Forign Key باشد وجدول Master هنوز بارگذاری نشده باشد ، خطا رخ خواهدداد.
درمورد تکمیل تر شدن برنامه ، همانطور که گفتم هر برنامه ای قابلیت گسترش زیادی دارد ولی باید دامنه استفاده ازآن هم زیاد باشد تا ارزش پرداختن داشته باشد. درمورد تابع خودمان هم می توان چک کرد Table غایب در مبدا ، آیا یک کلید اصلی دارد؟ در صورت وجود آیا در جدول مرتبط(ForignTable) مقداری هست که در Table وجودنداشته باشد؟ ودر غیر اینصورت اشکالی به ادامه برنامه گرفته نشود.
موفق باشید

abdoreza57
جمعه 07 فروردین 1394, 10:27 صبح
سلام

یه برنامه برای ثبت اطلاعات مشتریان درست کردم که چون اطلاعات تکمیلی بعدا قراره اضافه بشه پس اول یه کد به مشتری اختصاص میدم تا ثبت فاکتور و سایر موارد را بشه انجام داد بعدا موارد تکمیلی مثل نام و آدرس را به اون اضافه میکنم ....

راهکاری که موفق شدم انجامش بدم اینه
تو فایل 1 فاکتور و اطلاعات کلی ثبت میشه
تو فایل 2 جزییات یه جدول که مشخصات مشتریان هست


حالا میخوام همون یه جدول از فایل 2 جایگزین جدول هم نام خودش تو فایل 1 بشه بدون اینکه رلیشن خراب بشه

ضمنا تو حالت mde هم این امکان وجود داره یا خیر؟

منتظر پاسختون میمونم
خدا نگهدار

abdoreza57
شنبه 08 فروردین 1394, 17:04 عصر
سلام


از دوستان کسی نمیدونه ضمیمه پست 27 را چطور باید تغییر بدم تا به هدفم که تو پست 32 هست برسم ؟
خیلی کلنجار رفتم نشد !

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

منتظرم

Abbas Amiri
پنج شنبه 13 فروردین 1394, 11:25 صبح
سلام

یه برنامه برای ثبت اطلاعات مشتریان درست کردم که چون اطلاعات تکمیلی بعدا قراره اضافه بشه پس اول یه کد به مشتری اختصاص میدم تا ثبت فاکتور و سایر موارد را بشه انجام داد بعدا موارد تکمیلی مثل نام و آدرس را به اون اضافه میکنم ....

راهکاری که موفق شدم انجامش بدم اینه
تو فایل 1 فاکتور و اطلاعات کلی ثبت میشه
تو فایل 2 جزییات یه جدول که مشخصات مشتریان هست


حالا میخوام همون یه جدول از فایل 2 جایگزین جدول هم نام خودش تو فایل 1 بشه بدون اینکه رلیشن خراب بشه

ضمنا تو حالت mde هم این امکان وجود داره یا خیر؟

منتظر پاسختون میمونم
خدا نگهدار

با سلام و تبریک سال جدید ، آرزو می کنم شما و همه عزیزان کاربران این فروم ، سال خوبی را پیش رو داشته باشید.

برای مورد مطرح شده راه حل ساده است . در روال کلیک انتقال فایل کدهای زیر را وارد کنید:
Private Sub Command0_Click()
Dim ExtDb As String
DoCmd.CopyObject , "FactorsTemp", acTable, "tblFactors"
ExtDb = CurrentProject.Path & "\2.mdb"
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblFactors"
DoCmd.RunSQL "DELETE * FROM tblCucstomers"
DoCmd.SetWarnings True
CurrentDb.Execute "INSERT INTO tblCucstomers SELECT * FROM tblCucstomers IN '" & ExtDb & "'"
CurrentDb.Execute "INSERT INTO tblFactors SELECT * FROM FactorsTemp"
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "FactorsTemp"
DoCmd.SetWarnings True
End Sub


جهت تبدیل به فایل mde قبل از کانورت ، در خط چهارم پسوند mde را بکار ببرید
ExtDb = CurrentProject.Path & "\2.mde"
با توجه به خطاهای احتمالی که ممکن است بوجود آیند ، می توانید روالهای مدیریت خطا را در کدهای فوق اعمال کنید.
امیدوارم راه حل مفید باشد.
موفق باشید.