فتح قاعدة بيانات من قاعدة بيانات أخرى

[kaser906]

السلام عليكم ورحمة الله وبركاتة

بالمرفق

احاول فتح قاعدة بيانات بملحق  accdr محمية بكلمة مرور

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

عند استخدام نفس الاكواد لفتح قاعدة بيانات بملحق accdb

يتم فتح القاعدة بدون مشاكل

استخدمت هذا الكود

Private Sub أمر0_Click()
With New Access.Application
.OpenCurrentDatabase "C:\Users\User pc\Desktop\Trb.accdr", , "123"
.UserControl = True
.RunCommand acCmdAppMaximize
End With
Application.Quit
End Sub

واستخدمت هذا الكود

Private Sub أمر1_Click()
Dim strAccessExe As String, strDB As String


  Static acc As Access.Application

  Dim db As DAO.Database

  Dim strDbName As String

 strDbName = GetDBDir & "C:\Users\User1 pc\Desktop\Trb.accdr"

  Set acc = New Access.Application

  acc.Visible = True

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

  acc.OpenCurrentDatabase strDbName


db.Close
  Set db = Nothing
DoCmd.Quit

End Sub

ولكن الكود الاول والثاني لم يأتي بنتيجة

المطلوب : التعديل على الكود إن أمكن لفتح قاعدة بيانات بصيغة accdr

[jjafferr]

وعليكم السلام

 

بما اني لم اجرب هذا الشيء ، فاضطررت ان ابحث عنه ، ولقيت هذين الحلين من هنا:

https://answers.microsoft.com/en-us/office/forum/office_2010-access/open-accdr-file-protected-with-database-password/0c363087-577e-4888-a970-d2a67276bae5?page=3

 

الاول يتطلب ادخال الباسورد

Dim strPath As String

 
strPath = "YourPath\To\OtherDatabase.accdr"

Application.FollowHyperlink strPath

 

والاخر

Sub StartPasswordedDatabaseRuntime( _
        strPathToDatabase As String, _
        Optional strPassword As String, _
        Optional strPathToRuntime As String, _
        Optional blnQuit As Boolean)
        
    ' Start a runtime database that has a database password.

 

    Dim appRT As Access.Application
    Dim strPathToDummy As String
    Dim blnStillOpen As Boolean
    
    Const Q As String = """"
    
    If Len(strPassword) = 0 Then
        strPassword = InputBox("Please enter password:")
    End If
    
    If Len(strPathToRuntime) = 0 Then
        strPathToRuntime = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
    End If
    
    strPathToDummy = CurrentProject.path & "\Dummy.accdb"
    If Len(Dir(strPathToDummy)) = 0 Then
        Application.DBEngine.CreateDatabase strPathToDummy, dbLangGeneral, dbVersion120
    End If
    
    Shell _
        Q & strPathToRuntime & Q & " " & Q & strPathToDummy & Q & " /runtime", _
        vbNormalFocus

 

    Set appRT = GetObject(strPathToDummy)


    With appRT
        .CloseCurrentDatabase
        .OpenCurrentDatabase strPathToDatabase, , strPassword
    End With

 

    On Error Resume Next
    blnStillOpen = True
    Do While blnStillOpen
        DoEvents
        Err.Clear
        If appRT Is Nothing Then
            blnStillOpen = False
        ElseIf Len(appRT.CurrentProject.path) = 0 Then
            blnStillOpen = False
        End If
        If Err.Number <> 0 Then
            blnStillOpen = False
        End If
    Loop
    
    If blnQuit Then
        Application.Quit   ' if we're done here.
    End If

 

End Sub

 

جعفر

[kaser906]

7 ساعات مضت, jjafferr said:

بما اني لم اجرب هذا الشيء ، فاضطررت ان ابحث عنه ، ولقيت هذين الحلين من هنا:

مع الأسف استاذنا لم أصل إلى نتيجة

 

Open.rar

[kaser906]

رفع

[Shivan Rekany]

في ٤‏/٧‏/٢٠١٨ at 20:43, kaser906 said:

مع الأسف استاذنا لم أصل إلى نتيجة

 

Open.rar

القاعدة تبعك هو من نوع accdb
قم برفع القاعدة من نوع accdr لكي نعمل العمليات والتجارب
تحياتي

[kaser906]

في ٧‏/٧‏/٢٠١٨ at 18:51, Shivan Rekany said:

قم برفع القاعدة من نوع accdr لكي نعمل العمليات والتجارب

مرحبا بك استاذ شفان

تفضل هذه قاعدة بصغة accdr

ww.rar