اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

اقتباس

 DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\myOldDB.mdb", acForm, "formName", "FormName", False

كود خاص باستبدال نموذج من قاعدة إلى قاعدة أخرى 

القاعدة الأخرى محمية بكلمة مرور فعند الضغط على  زر الكود أعلاه تظهر رسالة كلمة مرور القاعدة الأخرى

المطلوب الأول : إضافة كلمة المرور في الكود .

المطلوب الثاني : استبدال جميع النماذج وليس نموذج واحد يقوم بالدوران على جميع النماذج في القاعدة الحالية ثم يستبدلها من القاعدة الأخرى "الهدف"

ثم يقوم بإنهاء العملية .

قام بنشر (معدل)

بالمرفق تجارب حاولت لكن لم تنجح

Dim App As Access.Application, strPath As String
Set App = New Access.Application
strPath = Application.CurrentProject.Path & "\AlWathiq.accdb"
'DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acForm, "Form2", "Form2", False

Dim strAccessExe As String, strDB As String

  'Define as Static so the instance of Access

  'doesn't close when the procedure ends.

  Static acc As Access.Application

  Dim db As DAO.Database

  Dim strDbName As String

'The path and filename of the DB to open.

  strDbName = GetDBDir & strPath

  Set acc = New Access.Application

  acc.Visible = True

  Set db = acc.DBEngine.OpenDatabase(strDbName, False, False, ";PWD=123")
  
  acc.OpenCurrentDatabase strDbName

  acc.RunCommand acCmdAppMaximize
  
  'DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acForm, "Form2", "Form2", False


  db.Close


  Set db = Nothing
'With App
'    .DoCmd.RunCommand acCmdAppMinimize
'    .OpenCurrentDatabase strPath, , "123"
'    .DoCmd.Maximize

'    .Visible = True

'End With
'Set App = Nothing

أطمع في مساعدة أستاذي الكبير جعفر 

 

12.accdb

تم تعديل بواسطه saleh204
قام بنشر
2 ساعات مضت, saleh204 said:

بالمرفق تجارب حاولت لكن لم تنجح



 

   Dim wrkJet As Workspace

   Dim AbA As Database

    Dim tbl As TableDef

     Set wrkJet = DBEngine.Workspaces(0)
'
      Set AbA = wrkJet.OpenDatabase(Application.CurrentProject.Path & "\AlWathiq.accdb", False, False, ";PWD=123")

Dim App As Access.Application, strPath As String
Set App = New Access.Application
strPath = Application.CurrentProject.Path & "\AlWathiq.accdb"
DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acForm, "Form2", "Form2", False

Dim strAccessExe As String, strDB As String


  Static acc As Access.Application

  Dim db As DAO.Database

  Dim strDbName As String
    Set db = CurrentDb()


  strDbName = GetDBDir & strPath

  Set acc = New Access.Application

  acc.Visible = True
      Set db = acc.DBEngine.OpenDatabase(Application.CurrentProject.Path & "\AlWathiq.accdb", False, False, ";PWD=123")
'  Set db = acc.DBEngine.OpenDatabase(strDbName, False, False, ";PWD=123")
  
  acc.OpenCurrentDatabase strDbName

  acc.RunCommand acCmdAppMaximize
  
'  DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acForm, "Form2", "Form2", False


  db.Close


  Set db = Nothing

12.accdb

مشاركة متواضعه

هذا يفتح القاعده وفيها رقم سري

قام بنشر

استفسار الكود يعمل بنجاح

لكن عندما يتم إقفال الوحدات النمطية  "VBA" بكلمة مرور تخرج رسالة خطأ رقم 3011 وعند فتح الوحدة تختفي ويعمل كل شيء بنجاح.

المطلوب :

‏السؤال كيف نتغلب على هذه الرسالة ويعمل الكود بنجاح أثناء وضع كلمة المرور ، ‏حتى لا يستطيع العملاء بالاطلاع على الأكواد والكلمات السرية

وشكرا لكم

قام بنشر
8 دقائق مضت, saleh204 said:

استفسار الكود يعمل بنجاح

لكن عندما يتم إقفال الوحدات النمطية  "VBA" بكلمة مرور تخرج رسالة خطأ رقم 3011 وعند فتح الوحدة تختفي ويعمل كل شيء بنجاح.

المطلوب :

‏السؤال كيف نتغلب على هذه الرسالة ويعمل الكود بنجاح أثناء وضع كلمة المرور ، ‏حتى لا يستطيع العملاء بالاطلاع على الأكواد والكلمات السرية

وشكرا لكم

جرب تضيف هذا في بدايه الكود

On Error Resume Next

 

قام بنشر

بفضل من الله ثم جوابكم تم حل المشكلة

باقي الطلب :

‏إذا كان لدي مجموعة نماذج في القاعدة أريد أن أضيفها جميعا و يستثني النموذج الحالي 

 

ما الحل ؟

قام بنشر

شكراً لك أخي ابو ياسين المشولي

لقد أضفت طريقة لإضافة واستبدال جميع نماذج قاعدة البيانات الخارجية 

وأضع هذا المرفق ليستفيد منه أعضاء هذا المنتدى العامر

 

الفكرة هي : 

تحديث قاعدة بياناتك لدى العميل واستبدال بعض النماذج وتحديثها وإضافة الجديد .

نتمى أن يعجب الجميع 

UPForm.rar

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information