هذا الكود ـ في الآكسس ـ يقوم باستيراد جدول من قاعدة بيانات إلى أخرى :
DoCmd.TransferDatabase acImport, "Microsoft Access", "source database", acTable, "source table name", "destination table name", False
للعلم : الكود كله في سطر واحد (عندي)
فهل توجد في الفيجوال بيسك خاصية لعمل مثل هذا الكود أو أي طريقة أخرى تمكن من استيراد الجداول أو غيرها من قاعدة بيانات أخرى إلى قاعدةالبيانات المربوطة بالبرنامج الذي أعمل عليه .
وشكرا للجميع سلفاً
بعد البحث وجدت دالتين الأولى
Private Sub أمر0_Click()
AttachExclusive "جدول مراحل التدريس", "C:My DocumentsMYMDBبيانات.mdb", "جدول مراحل التدريس"
' اسم الدالة, الاسم الجديد للجدول , اسم الجدول في القاعدة الهدف
End Sub
Function AttachExclusive(AttachedName As String, SourceDB As String, SourceTable As String) As Integer
' Returns: TRUE = OK; FALSE = error
'
Dim db As Database, TD As TableDef
On Error GoTo AEx_Error
Set db = CurrentDb
Set TD = db.CreateTableDef(AttachedName)
TD.SourceTableName = SourceTable
TD.Connect = ";DATABASE=" & SourceDB & ";"
TD.Attributes = DB_ATTACHEXCLUSIVE
db.TableDefs.Append TD
AttachExclusive = True
AEx_Exit:
Exit Function
AEx_Error:
AttachExclusive = False
Resume AEx_Exit
End Function
تقوم بعمل ارتبط مع جدول في قاعدة بيانات أخرى وهي تعمل جيداً .
والثانية وهي على ظني تقوم بنسخ الجدول في قاعدة البيانات الهدف ولكن بعد تجارب وتجارب لم استطع اكتشاف سبب رسالة الخطأ التي تحصل عند تشغيل هذه الدالة وسأكتبها كاملة مع الوسائط لترى أين الخطأ وتخبرني :
Public Sub gfd()
Dim db As Database
Dim db2 As Database
Dim Tabl As TableDef
Set db = Application.CurrentDb
Set db2 = OpenDatabase("C:My DocumentsMYMDBLord DB.mdb")
Set Tabl = db.CreateTableDef("جدول احصائية")
CopyTableDef Tabl, db2, "جدول جديد2"
db.Close
db2.Close
End Sub
Function CopyTableDef(SourceTableDef As TableDef, TargetDB As Database, TargetName As String) As Boolean
'
Dim SI As Index, SF As Field, SP As Property
Dim T As TableDef, i As Index, f As Field, P As Property
Dim I1 As Integer, f1 As Integer, P1 As Integer
If SourceTableDef.Attributes And DB_ATTACHEDODBC Or SourceTableDef.Attributes And DB_ATTACHEDTABLE Then
CopyTableDef = False
Exit Function
End If
Set T = TargetDB.CreateTableDef(TargetName)
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To T.Properties.Count - 1
If T.Properties(P1).Name <> "Name" Then
T.Properties(P1).Value = SourceTableDef.Properties(P1).Value
T.Properties(P1).Properties("Inherited") = SourceTableDef.Properties(P1).Inherited
End If
Next P1
On Error GoTo 0
' Copy Fields
For f1 = 0 To SourceTableDef.Fields.Count - 1
Set SF = SourceTableDef.Fields(f1)
Set f = T.CreateField()
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To f.Properties.Count - 1
f.Properties(P1).Value = SF.Properties(P1).Value
f.Properties(P1).Properties("Inherited") = SF.Properties(P1).Inherited
Next P1
On Error GoTo 0
T.Fields.Append f
Next f1
' Copy Indexes
For I1 = 0 To SourceTableDef.Indexes.Count - 1
Set SI = SourceTableDef.Indexes(I1)
If Not SI.Foreign Then ' Foreign indexes are added by relationships
Set i = T.CreateIndex()
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To i.Properties.Count - 1
i.Properties(P1).Value = SI.Properties(P1).Value
i.Properties(P1).Properties("Inherited") = SI.Properties(P1).Inherited
Next P1
On Error GoTo 0
' Copy Fields
For f1 = 0 To SI.Fields.Count - 1
Set f = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
i.Fields.Append f
Next f1
T.Indexes.Append i
End If
Next I1
' Append TableDef
TargetDB.TableDefs.Append T
' Copy Access/User Table Properties
For P1 = T.Properties.Count To SourceTableDef.Properties.Count - 1
Set SP = SourceTableDef.Properties(P1)
Set P = T.CreateProperty(SP.Name, SP.Type)
P.Value = SP.Value
T.Properties.Append P
Next P1
' Copy Access/User Field Properties
For f1 = 0 To T.Fields.Count - 1
Set SF = SourceTableDef.Fields(f1)
Set f = T.Fields(f1)
For P1 = f.Properties.Count To SF.Properties.Count - 1
Set SP = SF.Properties(P1)
Set P = f.CreateProperty(SP.Name, SP.Type)
P.Value = SP.Value
f.Properties.Append P
Next P1
Next f1
' Copy Access/User Index Properties
For I1 = 0 To T.Indexes.Count - 1
Set SI = SourceTableDef.Indexes(T.Indexes(I1).Name)
If Not SI.Foreign Then ' don't copy foreign indexes - they're created by relationships
Set i = T.Indexes(I1)
For P1 = i.Properties.Count To SI.Properties.Count - 1
Set SP = SI.Properties(P1)
Set P = i.CreateProperty(SP.Name, SP.Type)
P.Value = SP.Value
i.Properties.Append P
Next P1
End If
Next I1
CopyTableDef = True
End Function
لك الشكر الجزيل
انتظرني حتى أجربها وسأرد قريباً ان استطعت
الواقع لم أجد رد يناسب ما قمت به من بحث فالشكر الجزيل لك
ولكني توصلت لطريقة تناسبني وما حبيت أترك الموضوع من غير رد والطريقة هي تشغيل أمر آكسس من داخل فيجوال بيسك عن طريق زر أمر أو ماشابه (واترك قواعد البيانات تدبر بعضها)وهي كالتالي :
Dim strdbname As String
Dim opjaccess As Object
On Error GoTo loaderror
strdbname = App.Path
strdbname = strdbname & " database.mdb"
Set objaccess = CreateObject("access.application")
With objaccess
.OpenCurrentDatabase filepath:=strdbname
DoCmd.DeleteObject acTable, "table name"
"DoCmd.TransferDatabase acImport, "Microsoft Access", "c:source databse.mdb", acTable, "source table name", "destination table name", False
Application.Quit
End With
Set objaccess = Nothing
Unload Me
Exit Sub
loaderror:
MsgBox Err.Description & Chr(13) & "frm" & Err.Source & "- number:" & CStr(Err.Number)
Unload Me
End Sub
من الأفضل نسخ الكود ولصقة في ملف وورد أو غيره وجعل اتجاه الكتابة (انجليزي) .
آمل الفائدة للجميع
الأخ ابو زياد
اشكر لك عدم تركك للموضوع وإكماله وهذا المطلوب من الأخوة جميعاً فبعضهم ما إن يحصل على الحل إلا ولاسلام ولاكلام .
وبخصوص الكود الذي كتبته فيسمى أتمة المهام وأظن أنه لابد من وضع مرجع للأكسس في مشروع الفيوجل بيسك وللعلم فهذا الكود يحتوي على عبارات خاصة بالفيوجل بيسك حتى لا يستعمله أحدهم في الأكسس .
ارجو الإجابة .
ولك تحياتي
الواقع لا بد من استخدام مثل هذه المراجع
المرجع الذي استخدمته هو
microsoft access 8.0 object library
وما نستغني عن المشورة .
ولك تحياتي
هذا الموضوع مغلق.
المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية
جارٍ التحقق من المتواجدين…