Jump to content
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

احضار محتويات فولدر خارجى الى البرنامج


Recommended Posts

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

اواد المساعدة فى احضار محتويات فولدر او مجلد خارجى على الهارديسك (فى اي مكان بالكمبيوتر) الى قاعدة البيانات فى النموذج الخصص لذلك

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

والصورة التالية توضح المطلوب

m.salama.thumb.png.227cc127bd1650e6b0c39

m.salama.rar

Link to post
Share on other sites
  • Replies 59
  • Created
  • Last Reply

Top Posters In This Topic

Top Posters In This Topic

Popular Posts

وعليكم السلام أخي اباجودي     استبدل هذا السطر If UBound(strFileNames) = 0 Then بهذا السطر If Len(strFileNames & "") = 0 Then   بسم الله عليك ايه يا اباجودي ، ما انت

الكود السابق: UBound(strFileNames) UBound معناه العدد الاكبر من strFileName ، ولكن للاسف بسبب الضغط على زر cancel ، فالمتغير strFileName يصبح Null ، لذلك لم يستطع الامر السابق اصطياد الخطأ

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

Posted Images

وعليكم السلام أخي محمد :-)

 

يا ريت توضح أكثر!!

 

جعفر

شو قصدك إحضارة لقاعدة البيانات؟

هل قصدك حفظه في قاعدة البيانات؟

و اذا جوابك كان نعم ، فالسؤال لماذا؟

 

جعفر

Link to post
Share on other sites

يا هلا استاذنا جعفر 

معني او قصدي بكلمة احضار الي قاعدة البيانات هي:

مثلا لدي في فولدر ثلاث ملفات بصيغ مختلفة مثلا صورة باي امتداد وملف word و pdf

اقصد هنا باحضار يعني يقوم البرنامج بقراءة ما بداخل الفولدر من حيث الاسم والصيغة. لكل ملف وتسجيله في النموذج الفرعي.

نعم اقصد حفظ بيانات ما داخل الفولدر في قاعدة البيانات.

الهدف من ذلك 

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

واذا كان هناك طريقة اوان فكرة افضل انا ارحب بها

شكرا لك

Edited by محمد سلامة(soft.sample)
Link to post
Share on other sites

حيا الله الاخوين محمد و جعفر

انا اشوف اذا كان فقط استعراض الملفات ان تتم خلال مربع قائمة وليس نموذج فرعي ! ومربع القائمة ليس يستند على جدول بل تعبئتها لحظيا عند تخزين المجلد في الاعلى !

ولكن لاحظت ان هناك حقل نوت بجانب كل ملف ! فمعناته هناك ملاحظات لكل ملف ! فاذا كان لابد منه ماينفعشي السيناريو السابق ولا بد من الاكمال والادراج في النموذج الفرعي !

وهناك استفسارين:

1. هل ممكن اختصار مسار المجلد كامل في حقل واحد وفي النموذج الرئيسي وهنا سيحتوي المسار مسار المجلد واسمه بدلا من فصل المسار والاسم

2. هل ممكن كذلك الاكتفاء في النموذج الفرعي بمسار الملف كاملا محتويا على امتداده ! ام لابد من الفصل !

تحياتي  وارجو استمرار الاستاذ جعفر بالمشاركة لافادة اكثر

Edited by رمهان
  • Like 1
Link to post
Share on other sites

وعليكم السلام أخوي الكريمين محمد  ورمهان :-)

 

فهمي للموضوع هو:

- لديك مجلدات لكل كتاب أو وارد ، والكتاب الصادر أو الوارد قد يحتوي على مجموعة ملفات.

س:

ما إسم هذه المجلدات؟

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

هل إسم المجلد له علاقة باي من حقول السجل؟

 

- تريد ان تفرز اسم وصيغة كل ملف موجود في المجلد الخاص للكتاب ، وهذه المعلومة تريدها في النموذج الفرعي.

س:

مثل ما قال الاخ رمهان ، مافي داعي لحفظ هذه الأسماء في الجدول. وفي احد مشاريعي ، طبقت طريقة قراءة محتوي المجلد في Listbox ، و عندما تريد فتح الملف ، تنقر مرتين على إسم الملف ، فيفتحه مباشرة من المجلد.

هل ممكن استعمال هذه الطريقة ، أو أنك تريد الأسماء في الجدول لأنك تريد إضافة ملاحظات لكل ملف؟

س:

شرحت لك أعلاه طريقة فتح الملف ، سواء بطريقتي أو بطريقتك في النموذج الفرعي.

فلماذا تريد أن تحفظ الملف داخل قاعدة البيانات؟

حفظ الملفات داخل قاعدة البيانات غلط ، إلا في حدود جدا ضيقة ، وإلا فسيكبر حجم قاعدة بياناتك بطريقة مهولة ، وقد تصل إلى مرحلة العطب أو عدم إمكانية إضافة سجلات بها ، انا رأيت مثل هذه البرنامج :-(

 

جعفر

  • Like 1
Link to post
Share on other sites

ياهلا باستاد رمهان واستاذ جعفر

اولا وقبل اي شئ يكفيني شرفا ان تعلقوا انتم الاثنين علي موضوعي

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

اما بشان قراءة ما بداخل المجلد فانا احتاج حقل الملاحظات. ولا اريد ان اعرضهم في مربع قائمةListbox 

اريد ان اعرضهم داخل نموذج فرعي بنفس صيغة الصورة بعاليه 

طبعا المرفقات موجوده داخل فولدر بالبرتشن D داخل مجلد البرنامج 

 

اما بالنسبة لسؤالين استاذي رمهان. 

1-اريد فصل اسم المجلد من المسار

2- اريد فصل اسم وصيغة الملف من مسارهم ايضا

وذلك لاسباب تتعلق بالتوسعة المستقبلية للبرنامج 

بارك الله فيكم واشكركم شكرا جزيلا

Edited by محمد سلامة(soft.sample)
Link to post
Share on other sites

اوك . تمام

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

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

تحياتي

  • Like 1
Link to post
Share on other sites

تحياتي استاذ رمهان

بالفعل هذه الجزئية التي ذكرتها الاخيرة كنت اراد ان اطلبها ولكن بعد تنفيذ المطلب الاولني

فعلا كنت. الواد ان اقول اذا حذفت ملف او غيرت اسمه او اضفت ملف جديد داخل الفولدر فكان لابد من التزامن

بارك الله فيك

Link to post
Share on other sites

اعزائي

معناته نحن الآن نحتاج السيناريو او الفكرة التي تجعل السجلات متزامنة مع محتويات الفولدر وخصوصا ان هناك عمود ملاحظة تخص ملف بعينه !

نحتاج الفكرة او الطريقة او السيناريو ومسألة التنفيذ سهلة !

نفكر وفكرو وعلينا وعليكم لا تبخلو ! شاركونا الافكار !

 

تحياتي

Link to post
Share on other sites

يوجد مثال  للاخت زهرة ربما تستفيد منه

za-OpenAllFiles.rar

شكرا اخي نهر الفنون على المشاركة !

وسبحان الله هذه الاستاذة غائبة حاضرة في كل مكان باعمالها الخالدة !

 

مفيشجديد ياستاذه

صبرا ال ياسر !

كنت حاب نشوف افكار قبل ما انفذ ما لدي ! 

قريبا اخ محمد ارفع المشاركة ! واكيد الاستاذ جعفر مسافر !

Edited by رمهان
Link to post
Share on other sites

وعليكم السلام أخي محمد :smile:

أخي رمهان ، رحم الله والديك على السؤال عني :wink2:

 

السؤال ظاهرا سهل ، ولكنه ليس كذلك :blink:

 

اللي عملته هو:

1. تغيير اسم النموذج الى frm_wared ، والنموذج الفرعي الى sfrm_emp_wared ،

2. في النموذج الرئيسي ، اضغط على زر المجلد ، وتستطيع اختيار المجلد الذي به الملفات:

207.Clipboard05.thumb.jpg.d67fab2acdd956

.

3. اضفت حقل جديد في الجدول للنموذج الفرعي ، اسمه File_Check ، ونستفيد منه في تلوين وتعريف السجل ، وعملناه مخفي:

207.Clipboard00.thumb.jpg.b9b0c593ac654e

.

4. عملنا تنسيق شرطي لأحد الحقول (تستطيع ان تعمله لبقة الحقول ان احببت):

207.Clipboard01.thumb.jpg.016dd6b96afb7c

.

وهذان هما الشرطان فيه:

207.Clipboard02.thumb.jpg.961893c29e33a1

.

والالوان معناها:

اللون الابيض: هناك ملف في المجلد بنفس الاسم ،

اللون الاخضر: هذا السجل لا يوجد ملف بنفس اسمه ،

اللون الازرق: هذا الملف موجود في المجلد وغير موجود في السجلات،

.

5. وهذه نتيجة احد السجلات:

207.Clipboard03.thumb.jpg.969d570ce26619

.

6. وعندما تريد حذف السجل:

207.Clipboard04.thumb.jpg.f1b72f8f41c298

.

 

العمل على البرنامج اسهل من شرحه :smile:

وهذا هو الكود كاملا:

Option Compare Database

Private Sub cmd_Open_Folder_Click()
 
    Dim strFolderName As String
    Dim strMsg As String
    
    If Len(Me.pate & "") <> 0 Then
    
        Dim Msg, Style, Response
        Msg = "مسار الملف موجود ، هل تريد تغيير المسار" & vbCrLf & _
              "هل انت متاكد انك تريد الاستمرار في العملية" & vbCrLf & _
              "Do you want to continue ?"

        Style = vbYesNo + vbCritical + vbDefaultButton2
        Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        If Response = vbYes Then

                    
            strMsg = "رجار اختيار المجلد" & vbCrLf & _
                     "What Folder you want to select?"
            strFolderName = BrowseFolder(strMsg)
            
            If Len(strFolderName & "") <> 0 Then
                Me.pate = strFolderName
                Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1)
            End If
    
        End If
    
    Else
    
            strMsg = "رجار اختيار المجلد" & vbCrLf & _
                     "What Folder you want to select?"
            strFolderName = BrowseFolder(strMsg)

            If Len(strFolderName & "") <> 0 Then
                Me.pate = strFolderName
                Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1)
            End If
            
    End If  'Len

    'now bring the files from the folder
    Call Make_File_Array
    
End Sub

Function Make_File_Array()
On Error GoTo err_Make_File_Array

'Folder info

    Dim File_Count As Integer
    Dim fdr As Variant
    Dim Files_Array() As Variant
    
    
    iPath_In = Me.pate
    iCondition = "*.*"
    
    'No Path, exit
    If Len(iPath_In & "") = 0 Then Exit Function
    
    'get the file count from the Forlder, and
    'place the files in an array
    fdr = Dir(iPath_In & "\" & iCondition)
    File_Count = 0
    Do While fdr <> ""
        File_Count = File_Count + 1
        
        ReDim Preserve Files_Array(File_Count)
        Files_Array(File_Count) = fdr
        
        fdr = Dir
    Loop
    

    
'got the folder file count=File_Count, and the files=Files_Array(i)
'SubForm Records

    Dim rst As DAO.Recordset
    
    Set rst = Me.sfrm_emp_wared.Form.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    RC = rst.RecordCount
    
    
  '1. Make all Records, File_Check=1 (No File)
    For j = 1 To RC
        rst.Edit
            rst!File_Check = 1
        rst.Update
    
        rst.MoveNext
    Next j


  '2. Compare
    For i = 1 To UBound(Files_Array)    'File_Count
        iname_morfke = Files_Array(i)
        itayp = Mid(Files_Array(i), InStrRev(Files_Array(i), ".") + 1)
            
        rst.FindFirst "name_morfke='" & iname_morfke & "'"
                
            If rst.NoMatch Then
                'No Match
                rst.AddNew
                    rst!name_morfke = iname_morfke
                    rst!tayp = itayp
                    rst!File_Check = 2
                    rst!emp_id = Me.id_m
                rst.Update
                
            Else
                'Matching
                'but is it the same extension
                If rst!tayp = itayp Then
                    'Matching
                    rst.Edit
                        rst!File_Check = 0
                    rst.Update
                Else
                    'No Match
                    rst.AddNew
                        rst!name_morfke = iname_morfke
                        rst!tayp = itayp
                        rst!File_Check = 2
                        rst!emp_id = Me.id_m
                    rst.Update
                End If
            End If
        
    Next i
    
    rst.Requery

Exit Function

err_Make_File_Array:

    If Err.Number = 3021 Then
        'ignor, SubForm is empty
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function
Private Sub Form_Current()

    'now bring the files from the folder
    Call Make_File_Array
           
End Sub

 

 

جعفر

207.1.m.salama.accdb.zip

  • Like 1
Link to post
Share on other sites

حياك الله اخوي جعفر داءما وابدا

بنظرة سريعة  ماقصرت والله ! دائما مبدع !

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

اجمل تحية

 

  • Like 1
Link to post
Share on other sites

حيا الله أخوي رمهان :smile:

 

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

بالاضافة الى كيفية جعل البرنامج يشتغل بأقل تدخل من المستخدم :smile:

 

وهنا (وبعد الغداء :smile:) ساشرح البرنامج بطريقة مفصلة اكثر:

  1. عندما تختار المجلد ، فتلقائيا البرنامج سيأخذ اسم المجلد ومساره ، واسم الملفات الموجودة فيه ، ويضعها في النموذج الفرعي ،
  2. اذا كان هناك اسم في حقل مسار المجلد ، وضغطت على زر اختيار المجلد ، فسيطلب منك البرنامج تأكيد هذه العملية ،
  3. الكود يعمل على الحدث الحالي للنموذج الرئيسي ، فلا يحتاج الى تدخل من المستخدم ،
  4. في كل مرة تذهب الى سجل ، يعمل الكود على مقارنة معلومات المجلد بالمعلومات الموجودة في سجلات هذا الوارد ،
  5. السجل باللون الابيض معناه ان السجل والملف هما بنفس الاسم ،
  6. السجل باللون الازرق معناه ان هناك ملفات ولا توجد سجلات لهم ، لهذا السبب ، فالبرنامج استورد الاسماء ووضعها في السجل ، ولا تهتم باللون ، لأنك عندما تذهب الى سجل آخر ، ثم ترجع الى هذا السجل ، سترى ان الاسماء اصبحت بيضاء :smile:
  7. السجل باللون الاخر معناه انه لا يوجد ملف بهذا الاسم في المجلد ، وعليه تستطيع ان تحذفه ان شئت ، وعندما تضغط على طرف السجل وتضغط على زر الحذف ، فسيطلب منك البرنامج تأكيد الحذف ،
  8. البرنامج لا يحذف اي سجل تلقائيا.

 

جعفر

  • Like 2
Link to post
Share on other sites

الله الله الله 

والله العظيم استاذ جعفر منا عارف كيف اشكرك 

عمل مبدع ورائع جدا

تابعت الشرح وعجبني جدا

افكارك ماشاءالله

سوف اعينه بتمعن عندما اذهب للبيت. ومشاعري متوقف عليه 

واقول لك 

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

بجد متشكر جدااااا استاذ جعفر

 

وتحياتي اخي وأستاذي رمهان والله ما قصرت . وانتظر مثالك

Edited by محمد سلامة(soft.sample)
Link to post
Share on other sites

بارك الله فيك استاذ جعفر 

تعديلات جميلة جدا وهى والحمد لله تفى بالغرض جدا

اريد فقط اخر تعديل

هذا الكود التالى كان الاستاذ رمهان امدنى به منذ فترة وهو يقوم بادراج المرفقات من الكمبيوتر الى النموذج الفرعى

On Error Resume Next
Dim x As FileDialog
Set x = Application.FileDialog(msoFileDialogFilePicker)
x.AllowMultiSelect = True
If x.Show = -1 Then
For I = 1 To x.SelectedItems.Count
CurrentDb.Execute "insert into [tbl_emp_wared]([emp_id],[file_loc]) values(" & ID & ",'" & x.SelectedItems(I) & "')"
Next I
Me.sfrm_emp_wared.Requery
End If

فتم التعديل على المرفق الاخير من قبلك استاذ جعفر وادراج زر جديد باسم "إدراج مرفقات من الكمبيوتر"  (انظر الصورة التالية) وتم وضع خلف هذا الزر الكود المذكور باعلى ويعمل بكفاءة

فقط اريد التعديل على هذا الكود لكى يتواكب مع التغير الذى تم فى النموذج الفرعى

واريده عند النقر عليه يقوم بنسخ المرفقات الى المجلد المختار بالنموذج الرئيسي

هذا فقط ما اريده وهو اخر شئ

ولكم جزيل الشكر استاذ جعفر واستاذ رمهان

ملحوظة : هذا الكود يحتاج الى تسجيل الاداة التالية حتى يعمل بكفاءة "microsoft office 14.0 objekt labray" 

003.thumb.png.db8ba9d348b7c401e266ced0ef

وهذا هو المرفق بعد اضافة الكود المذكور

 .2.m.salama.rar

تحياتى لكم وشكرا جزيلا استاذ جعفر

فقط اريد التعديل على هذا الكود لكى يتواكب مع التغير الذى تم فى النموذج الفرع

 ما هو التغير الذى حدث على النموذج الفرعى

طبقا للكود السابق كان يقوم بادراج رابط الملفات كامل مثلا (D:\Archives\المرفقات\942.pdf)

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

ارت فقط التوضيح

Edited by محمد سلامة(soft.sample)
Link to post
Share on other sites

مرحبا اعزائي

تفضل اخ محمد مع ملاحظة:

1. تم الغاء بعض الحقول حيث الاخر محسوب

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

متمنيا ان اثرينا الموضوع مع الاستاذ جعفر وحصلة الفائدة للجميع وكتب الله اجر الجميع

Private Sub أمر12_Click()
FileDialog(msoFileDialogFolderPicker).InitialFileName = CurrentProject.Path
If FileDialog(msoFileDialogFolderPicker).Show = -1 Then pate = FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub

Private Sub أمر12_LostFocus()
If pate.OldValue <> pate.Value Then
If MsgBox("تم تغيير المجلد .. وسيتم اضافة ملفات جديدة???", vbOKCancel) = vbOK Then
DoCmd.SetWarnings False
DoCmd.RunSQL "delete * from tbl_emp_wared where emp_id=" & id_m
xp = Dir(pate & "\")
Do While xp <> ""
DoCmd.RunSQL "insert into [tbl_emp_wared]([emp_id],[file_s]) values(" & id_m & ",'" & xp & "')"
xp = Dir
Loop
DoCmd.SetWarnings True
Me.tbl_emp_wared_نموذج_فرعي.Requery
Else
Undo
End If
End If
End Sub

تحياتي

m.salama.rar

Link to post
Share on other sites

تفضل :smile:

والكود اصبح:

Option Compare Database

    Dim rst As DAO.Recordset
    
Private Sub cmd_Open_desktob_Click()
'On Error Resume Next
'Dim x As FileDialog
'Set x = Application.FileDialog(msoFileDialogFilePicker)
'x.AllowMultiSelect = True
'If x.Show = -1 Then
'For i = 1 To x.SelectedItems.Count
'CurrentDb.Execute "insert into [tbl_emp_wared]([emp_id],[file_loc]) values(" & ID & ",'" & x.SelectedItems(i) & "')"
'Next i
'Me.sfrm_emp_wared.Requery
'End If

    Dim strFileNames As Variant
  
    'check if the Dir exists
    If Dir(Me.pate, vbDirectory) = "" Then
        MsgBox "المسار" & vbCrLf & Me.pate & vbCrLf & _
               "غير موجود في الكمبيوتر" & vbCrLf & _
               "Sorry, this folder does not exist"
        Exit Sub
    End If

    
    'call the open dialog API
    ' set the Filter for the Multi File Dialog, so it only shows these files
    'strFilter = "Image Files " & _
             "(*.JPG,*.JPEG,*.JPE,*.GIF,*.BMP,*.DIB,*.TIF,*.TIFF,*.PNG,*.PCX,*.PCD,*.ICO,*.WMF,*.EMF,*.EPS,*.fpx)" & vbNullChar & _
              "*.JPG;*.JPEG;*.JPE;*.GIF;*.BMP;*.DIB;*.TIF;*.TIFF;*.PNG;*.PCX;*.PCD;*.ICO;*.WMF;*.EMF;*.EPS;*.fpx" & vbNullChar & vbNullChar
    strFilter = "All Files " & _
             "(*.*)" & vbNullChar & _
              "*.*" & vbNullChar & vbNullChar
    sFolder = "C:\"
    
    ' call the API for the Multi File Dialog
    strFileNames = apiBrowseFiles("Select a File, OR Multiple Files", sFolder, , strFilter)
    
    ' user didn't select any file, s/he proceed cancel
    If UBound(strFileNames) = 0 Then
        Exit Sub
    End If
    
    SelectedFiles = UBound(strFileNames) ' number of selected files
        
    ' take the 1st file name and extract the Folder name from it
    ' Don't Dim sFolder, it has been declared as Global variable
    ' so that the last folder visited will be opened again
    sFolder = strFileNames(1)
    Do While Right(sFolder, 1) <> "\"
      sFolder = Left(sFolder, Len(sFolder) - 1)
    Loop
    sFolder = Replace(sFolder, "\\", "\")


    Set rst = Me.sfrm_emp_wared.Form.RecordsetClone
    
    
    ' Add the selected items, and seperate them by a ; so that we use it as Row Source for
    ' list the files selected in the Listbox lstMultipleFiles
    For i = 1 To UBound(strFileNames)
    
        FileExt = Right(strFileNames(i), 3)
        File_Path_Name = Replace(strFileNames(i), "\\", "\")
        File_Name = Replace(File_Path_Name, sFolder, "")
        
        ' Copy the original file to Folder in the main Form
        FileCopy File_Path_Name, Me.pate & "\" & File_Name
    
                rst.AddNew
                    rst!name_morfke = File_Name
                    rst!tayp = FileExt
                    rst!File_Check = 2
                    rst!emp_id = Me.id_m
                rst.Update
    Next i

End Sub

Private Sub cmd_Open_Folder_Click()
 
    Dim strFolderName As String
    Dim strMsg As String
    
    If Len(Me.pate & "") <> 0 Then
    
        Dim Msg, Style, Response
        Msg = "مسار الملف موجود ، هل تريد تغيير المسار" & vbCrLf & _
              "هل انت متاكد انك تريد الاستمرار في العملية" & vbCrLf & _
              "Do you want to continue ?"

        Style = vbYesNo + vbCritical + vbDefaultButton2
        Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        If Response = vbYes Then

                    
            strMsg = "رجار اختيار المجلد" & vbCrLf & _
                     "What Folder you want to select?"
            strFolderName = BrowseFolder(strMsg)
            
            If Len(strFolderName & "") <> 0 Then
                Me.pate = strFolderName
                Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1)
            End If
    
        End If
    
    Else
    
            strMsg = "رجار اختيار المجلد" & vbCrLf & _
                     "What Folder you want to select?"
            strFolderName = BrowseFolder(strMsg)

            If Len(strFolderName & "") <> 0 Then
                Me.pate = strFolderName
                Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1)
            End If
            
    End If  'Len

    'save this Record, to save the ID, so that the subForm can use it
    DoCmd.RunCommand acCmdSaveRecord
    
    'now bring the files from the folder
    Call Make_File_Array
    
End Sub

Function Make_File_Array()
On Error GoTo err_Make_File_Array

'Folder info

    Dim File_Count As Integer
    Dim fdr As Variant
    Dim Files_Array() As Variant
    
    
    iPath_In = Me.pate
    iCondition = "*.*"
    
    'No Path, exit
    If Len(iPath_In & "") = 0 Then Exit Function
    
    'get the file count from the Forlder, and
    'place the files in an array
    fdr = Dir(iPath_In & "\" & iCondition)
    File_Count = 0
    Do While fdr <> ""
        File_Count = File_Count + 1
        
        ReDim Preserve Files_Array(File_Count)
        Files_Array(File_Count) = fdr
        
        fdr = Dir
    Loop
    

    
'got the folder file count=File_Count, and the files=Files_Array(i)
'SubForm Records

    'Dim rst As DAO.Recordset
    
    Set rst = Me.sfrm_emp_wared.Form.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    RC = rst.RecordCount
    
    
  '1. Make all Records, File_Check=1 (No File)
    For j = 1 To RC
        rst.Edit
            rst!File_Check = 1
        rst.Update
    
        rst.MoveNext
    Next j


  '2. Compare
    For i = 1 To UBound(Files_Array)    'File_Count
        iname_morfke = Files_Array(i)
        itayp = Mid(Files_Array(i), InStrRev(Files_Array(i), ".") + 1)
            
        rst.FindFirst "name_morfke='" & iname_morfke & "'"
                
            If rst.NoMatch Then
                'No Match
                rst.AddNew
                    rst!name_morfke = iname_morfke
                    rst!tayp = itayp
                    rst!File_Check = 2
                    rst!emp_id = Me.id_m
                rst.Update
                
            Else
                'Matching
                'but is it the same extension
                If rst!tayp = itayp Then
                    'Matching
                    rst.Edit
                        rst!File_Check = 0
                    rst.Update
                Else
                    'No Match
                    rst.AddNew
                        rst!name_morfke = iname_morfke
                        rst!tayp = itayp
                        rst!File_Check = 2
                        rst!emp_id = Me.id_m
                    rst.Update
                End If
            End If
        
    Next i
    
    rst.Requery

Exit Function

err_Make_File_Array:

    If Err.Number = 3021 Then
        'ignor, SubForm is empty
        Resume Next
        
    ElseIf Err.Number = 9 Then
        'ignor, SubForm is empty
        Exit Function
        
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function
Private Sub Form_Current()

    'now bring the files from the folder
    Call Make_File_Array
           
End Sub

 

 

جعفر

207.2.m.salama.accdb.zip

  • Like 1
Link to post
Share on other sites

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

اشكرك استاذى جعفر بالفعل كودك الاخير هو مطابى بضبط

والله ما اعرف كيف اشكرك

واشكر استاذى رمهان شكرا جزيلا واقول له بارك الله فيك ولك الاجر والثوب باذن الله

واسمحو لى ان اتقدم بتلك الهدية البسيطة جدا

55d66513bcb4e_1.thumb.png.037399d3d8933255d66528122af_2.thumb.png.316fc9ebb42f30

Link to post
Share on other sites
  • 2 weeks later...
  • 3 months later...

السلام عليكم

اعود اليوم استاذ جعفر واطلب تعديل بسيط ان شاء الله.. حولت معه ولكني لم افلح

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

بارك الله فيك

Link to post
Share on other sites

وعليكم السلام أخي محمد :rol:

 

وهل تعتقد بأني لازلت اذكر ما عملته قبل 4 اشهر :blink:

 

رجاء اخبرني ما كنا نفعله ، وماذا تريد ان تفعل الان ، وبأمثله لوسمحت :rol:

 

 

جعفر

  • Like 1
Link to post
Share on other sites

Join the conversation

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

Guest
Reply to this topic...

×   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.

  • Recently Browsing   0 members

    No registered users viewing this page.




×
×
  • Create New...