استخلاص اسم قاعدة البيانات من المسار والاقاعدة معا

مرفق مثال

أتمني أن يكون هذا هو المطلوب

GetFileName.rar

الاستاذ محمد 

اجاباتك دائما شافية كافية 

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

حيث ان هذا الكود ممتاز  ولكن  يجب ان نحدد اسم القاعدة

هل استطيع  استبدال اسم القاعدة بالاسم الذي حصلت عليه   من المسار  كما ذكرته حضرتك  

اتمني تعديل الكود   شكرا

Try
            If Conn.State = ConnectionState.Open Then Conn.Close()


            If MsgBox("سوف يتم عمل نسخة احتياطية من قاعدة البيانات" & vbCrLf & "DataCopy   وضعها في مسار البرنامج في المجلد", vbMsgBoxRight + vbExclamation + vbYesNo, "نسخ احتياطي") = MsgBoxResult.Yes Then


                Application.DoEvents()


                'اذا وجد نسخة بهذا الاسم يمسحها
                If IO.File.Exists(Application.StartupPath & "\Compact.mdb") Then
                    IO.File.Delete(Application.StartupPath & "\Compact.mdb")

                End If


                ' كود ضغط واصلاح قاعدة البيانات

                Dim Engine

                Engine = CreateObject("JRO.JetEngine")

                Engine.CompactDatabase("provider=microsoft.jet.oledb.4.0;data source=" & Application.StartupPath & "\elmy_thanawy.mdb;user id=admin;jet oledb:database password=123321", _
                                       "provider=microsoft.jet.oledb.4.0;data source=" & Application.StartupPath & "\Compact.mdb;user id=admin;jet oledb:database password=123321")


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

                Kill(Application.StartupPath & "\elmy_thanawy.mdb")



                'كود اعادة تسمية قاعدة البيانات التي تم ضغطها واصلاحها

                My.Computer.FileSystem.RenameFile(Application.StartupPath & "\Compact.mdb", "elmy_thanawy.mdb")


                'كود التحقق من وجود المجلد DataCopy
                If IO.Directory.Exists(Application.StartupPath & "\DataCopy") = False Then


                    'ان لم يكن موجد يقوم بانشاء مجلد جديد
                    IO.Directory.CreateDirectory(Application.StartupPath & "\DataCopy")


                    ''انشاء مجلد جديد في وضع مخفي
                    'IO.Directory.CreateDirectory(Application.StartupPath & "\DataCopy").Attributes = FileAttributes.Hidden

                End If





                'كود نسخة قاعدة البيانات باسخدام البروجريس بار والتاريخ


                Dim GregorianDTF As System.Globalization.DateTimeFormatInfo = New System.Globalization.CultureInfo("Ar-Sy", True).DateTimeFormat

                GregorianDTF.Calendar = New System.Globalization.GregorianCalendar

                Dim DToday As String = DateTime.Today.ToString("dd-MM-yyyy", GregorianDTF)




                Dim CopyFrom, CopyTo As String

                CopyFrom = Application.StartupPath & "\elmy_thanawy.mdb"

                CopyTo = Application.StartupPath & "\DataCopy\" & DToday & ".mdb"

                ProgressBar1.Visible = True


                Dim sr As New IO.FileStream(CopyFrom, IO.FileMode.Open)
                Dim sw As New IO.FileStream(CopyTo, IO.FileMode.Create)

                Dim len As Long = sr.Length - 1


                For i As Long = 0 To len

                    sw.WriteByte(sr.ReadByte)

                    If i Mod 1000 = 0 Then

                        Application.DoEvents()

                        ProgressBar1.Value = i * 100 / len



                    End If

                Next



                'كود البحث عن قواعد البيانات لغاية قبل شهر من تاريخ اليوم ويقوم بحذفها مع ترك اخر قاعدتين بتاريخ قبل يوم



                Dim DAddDays As DateTime = GregorianDTF.Calendar.AddDays(DateTime.Today, -1)

                Dim DAddMonths As DateTime = GregorianDTF.Calendar.AddMonths(DateTime.Today, -3)

                Dim D_AddDays As String = DAddDays.ToString("dd-MM-yyyy", GregorianDTF)

                Dim D_AddMonths As String = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)


                Do Until D_AddMonths = D_AddDays

                    If IO.File.Exists(Application.StartupPath & "\DataCopy\" & D_AddMonths & ".mdb") = True Then
                        Kill(Application.StartupPath & "\DataCopy\" & D_AddMonths & ".mdb")
                    End If


                    DAddMonths = GregorianDTF.Calendar.AddDays(DAddMonths, 1)

                    D_AddMonths = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)

                Loop


                'End
            End If

        Catch ex As Exception

            MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

            End

        End Try
 

ممكن توضح اكثر

السيد الفاضل

هذا الكود  يقوم بعمل نسخة من قاعدة البيانات  elmy_thanawy.mdb     الموجودة في مسار البرنامج الحالي     بجوار   الملف التنفيذي

لكن 

لو انا ححدت القاعدة وتكون في مجلد اخر

ثم حصلنا علي  مسار قاعدة البيانات  

كيف نجعل البرنامج  يقوم بعمل   نسخة احتياطية  من القاعدة    ويضعها في مجلد datacopy  

غير Application.StartupPath بالمسار الجديد

جربت انا ولكن لم ينفذ

برجاء تعديل الكود ووضعه مرة اخرى

try this

 If FolderBrowserDialog1.ShowDialog() = DialogResult.OK Then
            TextBox1.Text = FolderBrowserDialog1.SelectedPath

        Dim sPath As String = TextBox1.Text
        Try
                If Conn.State = ConnectionState.Open Then Conn.Close()


            If MsgBox("سوف يتم عمل نسخة احتياطية من قاعدة البيانات" & vbCrLf & "DataCopy   وضعها في مسار البرنامج في المجلد", vbMsgBoxRight + vbExclamation + vbYesNo, "نسخ احتياطي") = MsgBoxResult.Yes Then


                Application.DoEvents()


                'اذا وجد نسخة بهذا الاسم يمسحها
                If IO.File.Exists(sPath & "\Compact.mdb") Then
                    IO.File.Delete(sPath & "\Compact.mdb")

                End If


                ' كود ضغط واصلاح قاعدة البيانات

                Dim Engine

                Engine = CreateObject("JRO.JetEngine")

                Engine.CompactDatabase("provider=microsoft.jet.oledb.4.0;data source=" & sPath & "\elmy_thanawy.mdb;user id=admin;jet oledb:database password=123321", _
                                       "provider=microsoft.jet.oledb.4.0;data source=" & sPath & "\Compact.mdb;user id=admin;jet oledb:database password=123321")


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

                Kill(sPath & "\elmy_thanawy.mdb")



                'كود اعادة تسمية قاعدة البيانات التي تم ضغطها واصلاحها

                    My.Computer.FileSystem.RenameFile(sPath & "\Compact.mdb", "elmy_thanawy.mdb")


                'كود التحقق من وجود المجلد DataCopy
                If IO.Directory.Exists(sPath & "\DataCopy") = False Then


                    'ان لم يكن موجد يقوم بانشاء مجلد جديد
                    IO.Directory.CreateDirectory(sPath & "\DataCopy")


                    ''انشاء مجلد جديد في وضع مخفي
                    'IO.Directory.CreateDirectory(Application.StartupPath & "\DataCopy").Attributes = FileAttributes.Hidden

                End If





                'كود نسخة قاعدة البيانات باسخدام البروجريس بار والتاريخ


                Dim GregorianDTF As System.Globalization.DateTimeFormatInfo = New System.Globalization.CultureInfo("Ar-Sy", True).DateTimeFormat

                GregorianDTF.Calendar = New System.Globalization.GregorianCalendar

                Dim DToday As String = DateTime.Today.ToString("dd-MM-yyyy", GregorianDTF)




                Dim CopyFrom, CopyTo As String

                CopyFrom = sPath & "\elmy_thanawy.mdb"

                CopyTo = sPath & "\DataCopy\" & DToday & ".mdb"

                ProgressBar1.Visible = True


                Dim sr As New IO.FileStream(CopyFrom, IO.FileMode.Open)
                Dim sw As New IO.FileStream(CopyTo, IO.FileMode.Create)

                Dim len As Long = sr.Length - 1


                For i As Long = 0 To len

                    sw.WriteByte(sr.ReadByte)

                    If i Mod 1000 = 0 Then

                        Application.DoEvents()

                        ProgressBar1.Value = i * 100 / len



                    End If

                Next



                'كود البحث عن قواعد البيانات لغاية قبل شهر من تاريخ اليوم ويقوم بحذفها مع ترك اخر قاعدتين بتاريخ قبل يوم



                Dim DAddDays As DateTime = GregorianDTF.Calendar.AddDays(DateTime.Today, -1)

                Dim DAddMonths As DateTime = GregorianDTF.Calendar.AddMonths(DateTime.Today, -3)

                Dim D_AddDays As String = DAddDays.ToString("dd-MM-yyyy", GregorianDTF)

                Dim D_AddMonths As String = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)


                Do Until D_AddMonths = D_AddDays

                    If IO.File.Exists(sPath & "\DataCopy\" & D_AddMonths & ".mdb") = True Then
                        Kill(sPath & "\DataCopy\" & D_AddMonths & ".mdb")
                    End If


                    DAddMonths = GregorianDTF.Calendar.AddDays(DAddMonths, 1)

                    D_AddMonths = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)

                Loop


                'End
            End If

            Catch ex As Exception

                MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

                End

            End Try
        End If

السيد الفاضل

حضرتك هذا ليس هو المطلوب

في  هذا الحل ما زالنا نعرف اسم القاعدة

 لكن الذي اريده  بالتحديد  هو

هناك مسار  للبرنامج  يحتوي  علي اسم القاعدة   واسم المسار   للبرنامج     مثلا    c:\aaa\data.mdb

الزميل الفاضل    محمد    تركي    حدد   اسم الملف       مشكورا

اولا كيف  نحدد  مجاد البرنامج   ؟؟؟؟

ثانيا  :   كيف  يتم نسخ القاعدة  داخل  مجلد  اسمه datacopy    الموجود   بجوار  الملف التنفيذي