محمد سلامة قام بنشر أغسطس 13, 2015 قام بنشر أغسطس 13, 2015 السلام عليكم ورحمة الله وبركاته اواد المساعدة فى احضار محتويات فولدر او مجلد خارجى على الهارديسك (فى اي مكان بالكمبيوتر) الى قاعدة البيانات فى النموذج الخصص لذلك وذلك بعد تحديد مسار الفولدر المطلوب والموجود ايضا بالنموذج المطلوب والصورة التالية توضح المطلوب m.salama.rar
jjafferr قام بنشر أغسطس 13, 2015 قام بنشر أغسطس 13, 2015 وعليكم السلام أخي محمد :-) يا ريت توضح أكثر!! جعفر شو قصدك إحضارة لقاعدة البيانات؟ هل قصدك حفظه في قاعدة البيانات؟ و اذا جوابك كان نعم ، فالسؤال لماذا؟ جعفر
محمد سلامة قام بنشر أغسطس 14, 2015 الكاتب قام بنشر أغسطس 14, 2015 (معدل) يا هلا استاذنا جعفر معني او قصدي بكلمة احضار الي قاعدة البيانات هي: مثلا لدي في فولدر ثلاث ملفات بصيغ مختلفة مثلا صورة باي امتداد وملف word و pdf اقصد هنا باحضار يعني يقوم البرنامج بقراءة ما بداخل الفولدر من حيث الاسم والصيغة. لكل ملف وتسجيله في النموذج الفرعي. نعم اقصد حفظ بيانات ما داخل الفولدر في قاعدة البيانات. الهدف من ذلك لا لدي لكل خطاب وارد او صادر فولدر علي الكمبيوتر خاص بالمعاملة بها اي مرفقات خاصة بالمعاملة مثل ملف ورد الذي تم كتابة المعاملة به وصورة المعاملة بعد التصدير مسحوبة الاسكندر.. الخ واريد ان اربط هذه المرفقات بالمعاملة واذا كان هناك طريقة اوان فكرة افضل انا ارحب بها شكرا لك تم تعديل أغسطس 14, 2015 بواسطه محمد سلامة(soft.sample)
رمهان قام بنشر أغسطس 14, 2015 قام بنشر أغسطس 14, 2015 (معدل) حيا الله الاخوين محمد و جعفر انا اشوف اذا كان فقط استعراض الملفات ان تتم خلال مربع قائمة وليس نموذج فرعي ! ومربع القائمة ليس يستند على جدول بل تعبئتها لحظيا عند تخزين المجلد في الاعلى ! ولكن لاحظت ان هناك حقل نوت بجانب كل ملف ! فمعناته هناك ملاحظات لكل ملف ! فاذا كان لابد منه ماينفعشي السيناريو السابق ولا بد من الاكمال والادراج في النموذج الفرعي ! وهناك استفسارين: 1. هل ممكن اختصار مسار المجلد كامل في حقل واحد وفي النموذج الرئيسي وهنا سيحتوي المسار مسار المجلد واسمه بدلا من فصل المسار والاسم 2. هل ممكن كذلك الاكتفاء في النموذج الفرعي بمسار الملف كاملا محتويا على امتداده ! ام لابد من الفصل ! تحياتي وارجو استمرار الاستاذ جعفر بالمشاركة لافادة اكثر تم تعديل أغسطس 14, 2015 بواسطه رمهان 1
jjafferr قام بنشر أغسطس 14, 2015 قام بنشر أغسطس 14, 2015 وعليكم السلام أخوي الكريمين محمد ورمهان :-) فهمي للموضوع هو: - لديك مجلدات لكل كتاب أو وارد ، والكتاب الصادر أو الوارد قد يحتوي على مجموعة ملفات. س: ما إسم هذه المجلدات؟ أين توجد في الكمبيوتر؟ هل إسم المجلد له علاقة باي من حقول السجل؟ - تريد ان تفرز اسم وصيغة كل ملف موجود في المجلد الخاص للكتاب ، وهذه المعلومة تريدها في النموذج الفرعي. س: مثل ما قال الاخ رمهان ، مافي داعي لحفظ هذه الأسماء في الجدول. وفي احد مشاريعي ، طبقت طريقة قراءة محتوي المجلد في Listbox ، و عندما تريد فتح الملف ، تنقر مرتين على إسم الملف ، فيفتحه مباشرة من المجلد. هل ممكن استعمال هذه الطريقة ، أو أنك تريد الأسماء في الجدول لأنك تريد إضافة ملاحظات لكل ملف؟ س: شرحت لك أعلاه طريقة فتح الملف ، سواء بطريقتي أو بطريقتك في النموذج الفرعي. فلماذا تريد أن تحفظ الملف داخل قاعدة البيانات؟ حفظ الملفات داخل قاعدة البيانات غلط ، إلا في حدود جدا ضيقة ، وإلا فسيكبر حجم قاعدة بياناتك بطريقة مهولة ، وقد تصل إلى مرحلة العطب أو عدم إمكانية إضافة سجلات بها ، انا رأيت مثل هذه البرنامج :-( جعفر 1
محمد سلامة قام بنشر أغسطس 14, 2015 الكاتب قام بنشر أغسطس 14, 2015 (معدل) ياهلا باستاد رمهان واستاذ جعفر اولا وقبل اي شئ يكفيني شرفا ان تعلقوا انتم الاثنين علي موضوعي ثانيا ملحوظة بسيطه للاستاذ جعفر انا اعرف جيدا ان حفظ الملفات داخل القاعدة يؤدي الي زيادتها بشكل كبير جدا وقد تعطب.. وانا لا اقصد هذا وانما اقصد اضافة روابط الملفات في الجدول الفرعي. اما بشان قراءة ما بداخل المجلد فانا احتاج حقل الملاحظات. ولا اريد ان اعرضهم في مربع قائمةListbox اريد ان اعرضهم داخل نموذج فرعي بنفس صيغة الصورة بعاليه طبعا المرفقات موجوده داخل فولدر بالبرتشن D داخل مجلد البرنامج اما بالنسبة لسؤالين استاذي رمهان. 1-اريد فصل اسم المجلد من المسار 2- اريد فصل اسم وصيغة الملف من مسارهم ايضا وذلك لاسباب تتعلق بالتوسعة المستقبلية للبرنامج بارك الله فيكم واشكركم شكرا جزيلا تم تعديل أغسطس 14, 2015 بواسطه محمد سلامة(soft.sample)
رمهان قام بنشر أغسطس 14, 2015 قام بنشر أغسطس 14, 2015 اوك . تمام ولكن وبعد اذن اخي جعفر انه لابد من خلق سيناريو لتزامن وجود السجلات مع وجود الملفات. او حتى التعديل. فمثلا هل هناك احتمال حذف ملف يدويا مباشرة من الويندوز او اضافة ملف او حتى تعديل اسم ملف. تحياتي 1
محمد سلامة قام بنشر أغسطس 14, 2015 الكاتب قام بنشر أغسطس 14, 2015 تحياتي استاذ رمهان بالفعل هذه الجزئية التي ذكرتها الاخيرة كنت اراد ان اطلبها ولكن بعد تنفيذ المطلب الاولني فعلا كنت. الواد ان اقول اذا حذفت ملف او غيرت اسمه او اضفت ملف جديد داخل الفولدر فكان لابد من التزامن بارك الله فيك
رمهان قام بنشر أغسطس 15, 2015 قام بنشر أغسطس 15, 2015 اعزائي معناته نحن الآن نحتاج السيناريو او الفكرة التي تجعل السجلات متزامنة مع محتويات الفولدر وخصوصا ان هناك عمود ملاحظة تخص ملف بعينه ! نحتاج الفكرة او الطريقة او السيناريو ومسألة التنفيذ سهلة ! نفكر وفكرو وعلينا وعليكم لا تبخلو ! شاركونا الافكار ! تحياتي
رمهان قام بنشر أغسطس 16, 2015 قام بنشر أغسطس 16, 2015 (معدل) يوجد مثال للاخت زهرة ربما تستفيد منه za-OpenAllFiles.rar شكرا اخي نهر الفنون على المشاركة ! وسبحان الله هذه الاستاذة غائبة حاضرة في كل مكان باعمالها الخالدة ! مفيشجديد ياستاذه صبرا ال ياسر ! كنت حاب نشوف افكار قبل ما انفذ ما لدي ! قريبا اخ محمد ارفع المشاركة ! واكيد الاستاذ جعفر مسافر ! تم تعديل أغسطس 16, 2015 بواسطه رمهان
jjafferr قام بنشر أغسطس 19, 2015 قام بنشر أغسطس 19, 2015 وعليكم السلام أخي محمد أخي رمهان ، رحم الله والديك على السؤال عني السؤال ظاهرا سهل ، ولكنه ليس كذلك اللي عملته هو: 1. تغيير اسم النموذج الى frm_wared ، والنموذج الفرعي الى sfrm_emp_wared ، 2. في النموذج الرئيسي ، اضغط على زر المجلد ، وتستطيع اختيار المجلد الذي به الملفات: . 3. اضفت حقل جديد في الجدول للنموذج الفرعي ، اسمه File_Check ، ونستفيد منه في تلوين وتعريف السجل ، وعملناه مخفي: . 4. عملنا تنسيق شرطي لأحد الحقول (تستطيع ان تعمله لبقة الحقول ان احببت): . وهذان هما الشرطان فيه: . والالوان معناها: اللون الابيض: هناك ملف في المجلد بنفس الاسم ، اللون الاخضر: هذا السجل لا يوجد ملف بنفس اسمه ، اللون الازرق: هذا الملف موجود في المجلد وغير موجود في السجلات، . 5. وهذه نتيجة احد السجلات: . 6. وعندما تريد حذف السجل: . العمل على البرنامج اسهل من شرحه وهذا هو الكود كاملا: 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 1
رمهان قام بنشر أغسطس 19, 2015 قام بنشر أغسطس 19, 2015 حياك الله اخوي جعفر داءما وابدا بنظرة سريعة ماقصرت والله ! دائما مبدع ! لدي حل سارفعه قريبا وسبحان الله تلاقت الافكار في مسالة التنسيق الشرطي للتزامن بين السجلات ووجود الملفات في الفولدر ! اجمل تحية 1
jjafferr قام بنشر أغسطس 19, 2015 قام بنشر أغسطس 19, 2015 حيا الله أخوي رمهان مقارنة ملفات المجلد ، باسماء الملفات في السجلات ، هو الذي اخذ الكثير من الوقت ، ليس المقارنة نفسها ، وانما ماذا افعل اذا كان هناك ملف بدون سجل ، او سجل بدون ملف بالاضافة الى كيفية جعل البرنامج يشتغل بأقل تدخل من المستخدم وهنا (وبعد الغداء ) ساشرح البرنامج بطريقة مفصلة اكثر: عندما تختار المجلد ، فتلقائيا البرنامج سيأخذ اسم المجلد ومساره ، واسم الملفات الموجودة فيه ، ويضعها في النموذج الفرعي ، اذا كان هناك اسم في حقل مسار المجلد ، وضغطت على زر اختيار المجلد ، فسيطلب منك البرنامج تأكيد هذه العملية ، الكود يعمل على الحدث الحالي للنموذج الرئيسي ، فلا يحتاج الى تدخل من المستخدم ، في كل مرة تذهب الى سجل ، يعمل الكود على مقارنة معلومات المجلد بالمعلومات الموجودة في سجلات هذا الوارد ، السجل باللون الابيض معناه ان السجل والملف هما بنفس الاسم ، السجل باللون الازرق معناه ان هناك ملفات ولا توجد سجلات لهم ، لهذا السبب ، فالبرنامج استورد الاسماء ووضعها في السجل ، ولا تهتم باللون ، لأنك عندما تذهب الى سجل آخر ، ثم ترجع الى هذا السجل ، سترى ان الاسماء اصبحت بيضاء السجل باللون الاخر معناه انه لا يوجد ملف بهذا الاسم في المجلد ، وعليه تستطيع ان تحذفه ان شئت ، وعندما تضغط على طرف السجل وتضغط على زر الحذف ، فسيطلب منك البرنامج تأكيد الحذف ، البرنامج لا يحذف اي سجل تلقائيا. جعفر 3
محمد سلامة قام بنشر أغسطس 19, 2015 الكاتب قام بنشر أغسطس 19, 2015 (معدل) الله الله الله والله العظيم استاذ جعفر منا عارف كيف اشكرك عمل مبدع ورائع جدا تابعت الشرح وعجبني جدا افكارك ماشاءالله سوف اعينه بتمعن عندما اذهب للبيت. ومشاعري متوقف عليه واقول لك الله يغفر لك ذنوبك ما تقدم منها وما تاخر ويرحمك. رحمة واسعة. ويسكنك الفردوس الاعلي من الجنة بجد متشكر جدااااا استاذ جعفر وتحياتي اخي وأستاذي رمهان والله ما قصرت . وانتظر مثالك تم تعديل أغسطس 19, 2015 بواسطه محمد سلامة(soft.sample)
jjafferr قام بنشر أغسطس 19, 2015 قام بنشر أغسطس 19, 2015 حياك الله أخي محمد عندك يومين تخبرني إذا أردت أي تعديل ، لأني بعدها مسافر مرة ثانية جعفر
محمد سلامة قام بنشر أغسطس 20, 2015 الكاتب قام بنشر أغسطس 20, 2015 (معدل) بارك الله فيك استاذ جعفر تعديلات جميلة جدا وهى والحمد لله تفى بالغرض جدا اريد فقط اخر تعديل هذا الكود التالى كان الاستاذ رمهان امدنى به منذ فترة وهو يقوم بادراج المرفقات من الكمبيوتر الى النموذج الفرعى 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" وهذا هو المرفق بعد اضافة الكود المذكور .2.m.salama.rar تحياتى لكم وشكرا جزيلا استاذ جعفر فقط اريد التعديل على هذا الكود لكى يتواكب مع التغير الذى تم فى النموذج الفرع ما هو التغير الذى حدث على النموذج الفرعى طبقا للكود السابق كان يقوم بادراج رابط الملفات كامل مثلا (D:\Archives\المرفقات\942.pdf) اما بعد تعديل النموذج الفرعى اصبح يتم ادراج اسم المرفق وصيغته فقط ارت فقط التوضيح تم تعديل أغسطس 20, 2015 بواسطه محمد سلامة(soft.sample)
رمهان قام بنشر أغسطس 20, 2015 قام بنشر أغسطس 20, 2015 مرحبا اعزائي تفضل اخ محمد مع ملاحظة: 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
jjafferr قام بنشر أغسطس 20, 2015 قام بنشر أغسطس 20, 2015 تفضل والكود اصبح: 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 1
محمد سلامة قام بنشر أغسطس 20, 2015 الكاتب قام بنشر أغسطس 20, 2015 السلام عليكم ورحمة الله وبركاته اشكرك استاذى جعفر بالفعل كودك الاخير هو مطابى بضبط والله ما اعرف كيف اشكرك واشكر استاذى رمهان شكرا جزيلا واقول له بارك الله فيك ولك الاجر والثوب باذن الله واسمحو لى ان اتقدم بتلك الهدية البسيطة جدا
jjafferr قام بنشر أغسطس 29, 2015 قام بنشر أغسطس 29, 2015 شكرا جزيلا أخي محمد على هذا الإطراء الجميل :-) وعندي ملاحظة على لوحتك لي ، أنه لا دخل لمسقط بالبحرين :-) جعفر 3
محمد سلامة قام بنشر ديسمبر 29, 2015 الكاتب قام بنشر ديسمبر 29, 2015 السلام عليكم اعود اليوم استاذ جعفر واطلب تعديل بسيط ان شاء الله.. حولت معه ولكني لم افلح في مرفقك الاخير اريد التعديل عليه ليقوم بإدراج روابط او مسارات المرفقات في النموذج الفرعي.. بمعني كنا عند ادراج مرفقات من الكمبيوتر كان يضاف اسمائهم وامتدادهم فقط والذي اطلبه اليوم هو اضافة المسار الي مرفق ايضا بارك الله فيك
jjafferr قام بنشر ديسمبر 29, 2015 قام بنشر ديسمبر 29, 2015 وعليكم السلام أخي محمد وهل تعتقد بأني لازلت اذكر ما عملته قبل 4 اشهر رجاء اخبرني ما كنا نفعله ، وماذا تريد ان تفعل الان ، وبأمثله لوسمحت جعفر 1
محمد سلامة قام بنشر ديسمبر 29, 2015 الكاتب قام بنشر ديسمبر 29, 2015 ههههههههه حياك الله استاذ جعفر.. حاضر سوف. اشرح بالتفاصيل... مع ان لو فتحت المرفق الاخير ستضح الامر لك تحياتي
محمد سلامة قام بنشر ديسمبر 12, 2016 الكاتب قام بنشر ديسمبر 12, 2016 في ٢٠/٨/٢٠١٥ at 22:43, jjafferr said: تفضل والكود اصبح: 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 السلام عليكم استاذ جعفر. اعود اليك اليوم واطلب تعديل بسيط لم انتبه له في حينه علي هذا الكود بعاليه وهو يقوم بنسخ المرفقات من اي مجلد او فولدر بالكمبيوتر الي المسار المحدد.. مسار حفظ مرفقات البرنامج.. وهو يقوم بنسخ اي مرفق بدون تغيير اسمه يعني كما هو.. وهذا هو التعديل الذي اريده اريد ان يعاد تسمياتها بالشكل التالي اذا كان.رقم المسلسل مثلا 1 اذا المرفق ياخذ اسم At1-1 At هي اختصار لاسم مرفق وال 1 هي رقم المسلسل في المثال بعاليه وال 1 هي رقم المرفق المنسوخ في الفولدر وهذا مثال للمرفقات الخاصة بالمسلسل 1 داخل الفولدر At1-1 At1-2 At1-3 وهكذا واشكرك شكرا جزيلا علي كل نا وصلن اليه في هذا المثال.. بارك الله فيك
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.