شخابيط ابو جودى: سلسلة منافع مختلفة لتجميعات دوال عامة وافكار مختلفة ( FileDialog )

[ابو جودي]

يمكن عمل ذلك من خلال استخدام الربط المتأخر (Late Binding) أو الربط المتقدم (Early Binding)

وهذا يعتمد على الاحتياجات الخاصة بالتطبيق الذي تقوم بتطويره وعلى الاعتبارات التي ترغب في مراعاتها

الربط المتأخر (Late Binding):

المرونة:

يوفر المزيد من المرونة في حال تحتاج إلى تشغيل التطبيق على إصدارات مختلفة من تطبيق Microsoft Office دون الحاجة إلى إعادة كتابة الشيفرة

لا يتطلب تحديد مراجع (References) محددة والتى تختلف تبعا لاختلاف اصدار الأكسس 

التوافق:

يسمح بالتوافق مع تطبيقات Office على أنظمة التشغيل المختلفة بشكل أفضل

التحقق من وجود الكائنات:

يتطلب التحقق اليدوي من وجود الكائنات أو استخدام الكائنات بدون تحقق مسبق

 

الربط المتقدم (Early Binding):

الأداء:

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

التحقق التلقائي:

يتيح لك IntelliSense والتحقق التلقائي في وقت الكتابة، مما يسهل استكشاف واستخدام الكائنات المتاحة

الوثائق والدعم:

يوفر تحديد مراجع VBA معلومات وثائق أفضل ودعمًا تلقائيًا للأوامر والخصائص

الختام:

إذا كنت بحاجة إلى أقصى قدر من المرونة والتوافق وليس لديك اهتمام بالتحقق التلقائي والأداء الأقصي يمكنك استخدام الربط المتأخر

إذا كان الأداء والتحقق التلقائي والوثائق المفصلة هي الأمور الرئيسية قطعا سوف تفضل استخدام الربط المتقدم

عند استخدام الربط المتقدم يجب أن تأخذ في اعتبارك أن توفر ملفات التعريف (المراجع) قد تتغير مع إصدارات مختلفة من تطبيقات Office
لذا يجب عليك تحديثها بناءً على الإصدار الذي يتم استخدامه

طيب بالنسبة لى سوف افضل الربط المتقدم (Early Binding)
 

اسباب التفضيل :
يهمنى الأداء والمرونة والسرعة وان شاء الله اقدم لكم افكار عبقرية تقدم الاستفادة القصوى دون  اى عناء فى المستقبل
حيث تمكنت من معالجة السلبيات ان وجدت وهى كالاتى المكتبات 

- تم علاج مشكلة المكتبات فى هذا الموضوع : library reference: حفظ واسترجاع المكتبات المستخدمة( وداعا لفقد المكتبات بعد اليوم )
- علاج مشكلة اعادة كتابة الاكواد مرارا وتكرارا باستخدام موديول ذكى ولماح وشاطر 

طيب اولا اسم الموديول :  basFileUtilityKit
المرجع الذى يجب التأكد من اضافته : Microsoft Office 16.0 Object Library
طبعا الرقم 16.0 قد يكون 14.0 أو ....... الخ يختلف تبعا لاصدار الاكسس
 

تم استخدام Enumerated لاضفاء المرونة 
هو نوع بيانات يتكون من مجموعة من القيم المسماة تسمى العناصر أو الأعضاء أو التعداد أو التعداد من النوع أسماء
العداد عادة ما تكون معرفات تتصرف كثوابت في لغة البرمجه
يمكن أن يُنظر إلى النوع الذي تم تعداده باعتباره اتحادًا مميزًا من نوع الوحدة

الدوال داخل الموديول كالاتى

' Enumeration for the types of file dialogs
Enum EnumFileDialogType
    msoFileDialogFilePicker = 1
    msoFileDialogFolderPicker = 4
End Enum

' Enumeration for different file extensions
Enum EnumFileExtensions
    AllFiles
    TextFiles
    ExcelFiles
    ImageFiles
    VideoFiles
    AudioFiles
    PDFFiles
    WordFiles
    ' You can add additional file extensions as needed here
End Enum

' Enumeration for different options related to file paths
Enum EnumOptionFile
    FilePathWithFileName = 1
    FilePathWithoutFileName = 2
    FileNameWithExtension = 3
    FileNameWithoutExtension = 4
    FileExtensionOnly = 5
End Enum

Public ChosenFilePaths() As String
Dim TempChosenFilePaths() As String

    ' Check if the Microsoft Office Object Library is referenced
    ' Make sure to go to Tools > References and select the appropriate version
    ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016

' Function to open the file dialog and return the selected file paths
Function GetFileDialog(Optional ByVal EnumFileExtension As EnumFileExtensions = AllFiles, Optional ByVal AllowMultipleFiles As Boolean = False) As Variant
    Dim i As Integer
    Dim fileDialogObject As Object
    Dim FilePaths() As String

    ' Use TempChosenFilePaths as a temporary storage
    ReDim TempChosenFilePaths(1 To 1)

    Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker)

    With fileDialogObject
        .Title = "Select File"
        .AllowMultiSelect = AllowMultipleFiles
        .Filters.Clear

        ' Adding filters based on the selected file extension
        Select Case EnumFileExtension
            Case EnumFileExtensions.AllFiles
                .Filters.Add "All Files", "*.*"
            Case EnumFileExtensions.TextFiles
                .Filters.Add "Text Files", "*.txt"
            Case EnumFileExtensions.ExcelFiles
                .Filters.Add "Excel Files", "*.xlsx; *.xls"
            Case EnumFileExtensions.ImageFiles
                .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif"
            Case EnumFileExtensions.VideoFiles
                .Filters.Add "Video Files", "*.mp4; *.avi; *.mov"
            Case EnumFileExtensions.AudioFiles
                .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg"
            Case EnumFileExtensions.PDFFiles
                .Filters.Add "PDF Files", "*.pdf"
            Case EnumFileExtensions.WordFiles
                .Filters.Add "Word Files", "*.docx; *.doc"
            ' You can add additional file extensions as needed here
        End Select

        If .Show = -1 Then
            ' ReDim the array to the number of selected items
            ReDim FilePaths(1 To .SelectedItems.Count)

            ' Populate the array with selected item paths
            For i = 1 To .SelectedItems.Count
                FilePaths(i) = .SelectedItems(i)
                ' Add to TempChosenFilePaths
                TempChosenFilePaths(UBound(TempChosenFilePaths)) = FilePaths(i)
                ReDim Preserve TempChosenFilePaths(1 To UBound(TempChosenFilePaths) + 1)
            Next i

            ' Return the array
            GetFileDialog = JoinFilePaths(FilePaths)

            ' Update ChosenFilePaths with the temporary values
            ChosenFilePaths = TempChosenFilePaths
            ' Clear TempChosenFilePaths
            Erase TempChosenFilePaths
        Else
            ' Return an empty string if no file is selected
            GetFileDialog = ""
        End If
    End With

    ' Set file dialog object to nothing
    Set fileDialogObject = Nothing
End Function

' Function to join paths and set them to the global variable
Function JoinFilePaths(paths() As String) As String
    JoinFilePaths = Join(paths, vbCrLf)
End Function

' Function to check if ListBox contains a specific item
Function ListBoxContainsItem(listBox As Object, item As String) As Boolean
    Dim i As Integer
    ListBoxContainsItem = False
    For i = 0 To listBox.ListCount - 1
        If listBox.Column(0, i) = item Then
            ListBoxContainsItem = True
            Exit Function
        End If
    Next i
End Function

' Subroutine to add paths to ListBox in the form
Sub AddToFormListBox(frm As Object, paths() As String, ListBoxName As String, Optional ClearListBox As Boolean = True)
    Dim i As Integer
    Dim listBoxControl As Object

    ' Check if frm is not Nothing
    If Not frm Is Nothing Then
        ' Check if ListBox with the specified name exists in the form's controls
        On Error Resume Next
        Set listBoxControl = frm.Controls(ListBoxName)
        On Error GoTo 0

        ' If ListBox control exists, add or clear items
        If Not listBoxControl Is Nothing Then
            ' Clear ListBox if ClearListBox is True
            If ClearListBox Then
                listBoxControl.RowSource = ""
            End If

            ' Add unique non-empty items to ListBox
            For i = LBound(paths) To UBound(paths)
                If Trim(paths(i)) <> "" And Not ListBoxContainsItem(listBoxControl, paths(i)) Then
                    listBoxControl.AddItem paths(i)
                End If
            Next i
        Else
            ' Handle the case where ListBox control does not exist
            MsgBox "ListBox with name '" & ListBoxName & "' not found in the form.", vbExclamation
        End If
    End If
End Sub

' Subroutine to add paths to Access table
Sub AddToAccessTable(tableName As String, paths() As String)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Integer
    Dim filePath As String
    
    ' Open the database
    Set db = CurrentDb
    ' Open the table
    Set rs = db.OpenRecordset(tableName, dbOpenDynaset)
       
    ' Add each non-empty and non-duplicate path to the table
    For i = LBound(paths) To UBound(paths)
        filePath = Trim(paths(i))
        ' Check if the path does not already exist in the table
        If filePath <> "" And DCount("*", tableName, "FilePath='" & filePath & "'") = 0 Then
            rs.AddNew
            rs.Fields("FilePath").Value = filePath
            rs.Update
        End If
    Next i
    
    ' Close the recordset and database
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

' Function to open the folder dialog and return the selected folder path
Function GetFolderDialog() As String
    Dim folderDialogObject As Object
    Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker)

    With folderDialogObject
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .Show
    End With

    If folderDialogObject.SelectedItems.Count > 0 Then
        GetFolderDialog = folderDialogObject.SelectedItems(1)
    Else
        ' Handle the case where no folder is selected
        MsgBox "No folder selected.", vbExclamation
        GetFolderDialog = ""
    End If

    Set folderDialogObject = Nothing
End Function

' Function to get the desired option for a file path
Function GetFileOption(ByRef filePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = FilePathWithFileName) As String
    ' Check if the file exists
    If FileExists(filePath) Then
        ' Get file File Option using GetFileOption function
        Select Case EnumOptionFile
            Case FilePathWithoutFileName
                GetFileOption = Left(filePath, InStrRev(filePath, "\"))
    
            Case FilePathWithFileName
                GetFileOption = filePath
    
            Case FileNameWithExtension
                GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1)
    
            Case FileExtensionOnly
                GetFileOption = Right(filePath, Len(filePath) - InStrRev(filePath, "."))
    
            Case FileNameWithoutExtension
                GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1)
        End Select
    Else
        ' Return an empty string if the file does not exist
        GetFileOption = ""
    End If
End Function


' Function to get additional information about a file
Function GetFileInfo(filePath As String) As String
    ' Check if the file exists
    If FileExists(filePath) Then
        ' Get file information using GetFileInfo function
        Dim fileInfo As String
        fileInfo = "File Information:" & vbCrLf
        fileInfo = fileInfo & "Path: " & filePath & vbCrLf
        fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf
        fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf
        GetFileInfo = fileInfo
    Else
        ' Return an empty string if the file does not exist
        GetFileInfo = ""
    End If
End Function

' Function to create a new folder
Function CreateNewFolder(parentPath As String, folderName As String) As String
    Dim newFolderPath As String
    newFolderPath = parentPath & "\" & folderName
    MkDir newFolderPath
    CreateNewFolder = newFolderPath
End Function

' Function to check if a file exists
Function FileExists(ByVal filePath As String, Optional findFolders As Boolean = False) As Boolean
    Const vbReadOnly As Long = 1
    Const vbHidden As Long = 2
    Const vbSystem As Long = 4
    Const vbDirectory As Long = 16

    Dim attributes As Long
    attributes = (vbReadOnly Or vbHidden Or vbSystem)

    If findFolders Then
        attributes = (attributes Or vbDirectory) ' Include folders as well.
    Else
        ' Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right(filePath, 1) = "\"
            filePath = Left(filePath, Len(filePath) - 1)
        Loop
    End If

    ' If Dir() returns something, the file exists.
    FileExists = (Len(Dir(filePath, attributes)) > 0)
End Function

من خلال تلك الوحدة النمطية يمكن عمل الاتى

1- انتقاء مسار مجلد من خلال الدالة : GetFolderDialog
الاستدعاء: GetFolderDialog
 

2- انتقاء مسار ملف / ملفات من خلال الدالة : GetFileDialog
الاستدعاء:GetFileDialog(EnumFileExtensions, AllowMultipleFiles)
-قائمة EnumFileExtensions التى تضفى مرونة فى تحديد نوع الملفات التى تريد انتقائها
- AllowMultipleFiles تحديد ما اذا كنت تريد انتقاء ملف واحد فقط لتكون False  , أو ملفات متعددة لتكون True
 

3-استخلاص معلومات الملف من خلال الدالة : GetFileInfo
الاستدعاء:GetFileInfo(filePath)
 

4- التحكم فى خيارات الملف / الملفات من خلال الدالة : GetFileOption
وهى (المسار كاملا مع اسم الملف , مسار الملف فقط , اسم الملف مع الامتداد فقط , امتداد الملف فقط )
الاستدعاء:GetFileOption(filePath , EnumOptionFile)
 

5- اضافة مسار  الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة السابقة الى مربع قائمة
وذلك من خلال الدالة : AddToFormListBox
الاستدعاء:


6- اضافة مسار  الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة الى جدول 
من خلال الدالة: AddToAccessTable
الاستدعاء:


يتبع......

 

 

FileDialog.accdb

[عمر ضاحى]

واااااو 

ما شاء الله 

شرح ومعلومات مهمه وجديده على 

ما شاء الله تبارك الله 

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

الف شكر على المجهود الجبار ده 

[عمر ضاحى]

طلب اضافى ^_^

لو تعمل شروحات فيديو على اليوتيوب اعتقد هيكون معاك المجال اوسع لاضافة المزيد من الشرح والتوضيح 

[ابو جودي]

الان, عمر ضاحى said:

لو تعمل شروحات فيديو على اليوتيوب اعتقد هيكون معاك المجال اوسع لاضافة المزيد من الشرح والتوضيح 

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

اننى دائما اضع نصب عينى عند تطبيق الفكرة بقدر الامكان تحقيق المتطلبات الاتيه
1- ان تكون عامة بقدر الامكان بحيث يسهل استخدامها فى جميع المجالات والحلات وفق الرغبات دون اى قيود قدر الامكان ليسهل 
2- المرونة بحيث تتم كتابة الكود مرة واحدة وقد يكون وقت كتابته بذل الجهد فى الافكار كبير والعناء فى التنفيذ اكبر وقت تطويع الكود لتفيذ الفكرة
ولكن قمة المتعة فى سهولة الاستدعاء مستقبلا

ويعلم الله لما تم بذل الوقت والجهد وكان الحصاد بتلك المرونة والسهولة خطر على بالى مشاركة اخوانى واحبابى هذه الافكار التى تسهل عليهم مستقبلا الكثير من الوقت فى كتابة الاكواد وتقديم الحلول المرنة لحصاد النتائج المبهرة دون اى عناء يذكر