تعديل على كود

[TQTHAMI]

    Dim strDB As String
'Path & "\" & "Data" & "\" & "copy" & "\" & ss & ".mdb"
    strDB = CurrentProject.Path & "\" & "FolderN" & "\" & "1010" & "\Database1.mdb"
    Set appAccess = _
        CreateObject("Access.Application")
    appAccess.OpenCurrentDatabase strDB
    appAccess.DoCmd.OpenForm "xxxx"
    appAccess.Visible = True

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

حيث قمت بتغير الامتداد mdb ولكن لم تنجح معي

5555.rar

[الطحان]

Dim strDB As String
strDB = "C:\Users\ferry\Desktop\5555\FolderN\1010\bar.accdb"

عدل للمسار الصحيح
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strDB

If appAccess.CurrentDb() Is Nothing Then
    MsgBox "فشل في فتح قاعدة البيانات!"
Else
    appAccess.DoCmd.OpenForm "LoadingBar"
    appAccess.Visible = True
End If

5556.rar

تم تعديل يونيو 10, 2023 بواسطه الطحان

[TQTHAMI]

 

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

لم يعمل معي 

وارفقت لك المثال وضعت فيه مثالين الأول شغال ولكن بـ كنابه الأسماء 

والثاني هو المطلوب ولكن لابد انه  يأخذ البيانات من الحقول

 

2 ساعات مضت, الطحان said:

appAccess.OpenCurrentDatabase strDB

المثال.rar

[AbuuAhmed]

جرب هذا الكود:
 

Private Sub Command1_Click()
    Dim strDB As String
    
    strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".accdb"
    Set appAccess = CreateObject("Access.Application")
    appAccess.OpenCurrentDatabase strDB
    appAccess.DoCmd.OpenForm Me.form_open
    appAccess.Visible = True
    
    Set appAccess = Nothing
End Sub

 

تم تعديل يونيو 10, 2023 بواسطه AbuuAhmed

[TQTHAMI]

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

يامرحبا تراحيب المطر 
يسعد صباحك أبو احمد 
نعم هذا ما اردته 
بارك الله فيك ونفع بعلمك ورزقك حسن الخاتمة 
والشكر موصول للأخ الطحان

[TQTHAMI]

يسعد مساءك أبو احمد 

الكود رائع لكن واجهتني اشكاليه 
وهي بعض الملفات امتدادها  accdb
والبعض الاخر امتدادها mdb

فالكود يفتح امتداد واحد

[Moosak]

منذ ساعه, TQTHAMI said:

يسعد مساءك أبو احمد 

الكود رائع لكن واجهتني اشكاليه 
وهي بعض الملفات امتدادها  accdb
والبعض الاخر امتدادها mdb

فالكود يفتح امتداد واحد

خلي الكود يفتحلك مستعرض الملفات وتختار منه الملف بدل ما هو مكتوب في الكود أخوي طلال 🙂 

[AbuuAhmed]

تعديل للكود السابق:
 

Private Sub Command1_Click()
    Dim strDB As String
    
    On Error Resume Next
    
    Set appAccess = CreateObject("Access.Application")
    
    Err.Clear
    strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".accdb"
    appAccess.OpenCurrentDatabase strDB
    'If Err.Number <> 0 Then
    If Err.Number = 7866 Then
        strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".mdb"
        appAccess.OpenCurrentDatabase strDB
    End If
    
    appAccess.DoCmd.OpenForm Me.form_open
    appAccess.Visible = True
    
    Set appAccess = Nothing
End Sub

 

تم تعديل يونيو 11, 2023 بواسطه AbuuAhmed

[TQTHAMI]

6 ساعات مضت, Moosak said:

خلي الكود يفتحلك مستعرض الملفات وتختار منه الملف بدل ما هو مكتوب في الكود أخوي طلال 🙂

بارك الله فيك اخي موسى نعم فكرت فيها وسويتها 

اخي أبو احمد لك كل  الشكر والعرفان على تعديل الكود 

وتقبلوا  فائق الاحترام والتقدير