اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

في الموضوع المطروح على الرابط .... http://www.officena.net/ib/index.php?showtopic=45643

 

تمت الإجابة على موضوع إنشاء الملجلدات برقم الموظف

وآثرت إستكمال الردّ على تشعب الأسئلة ، بموضوع جديد تحقيقاً لشروط المنتدى

 

وهنا سنتحدث ونطبق آلية نسخ و نقل الملفات بين المجلدات

حيث سنقوم ببناء الروتين بعد التحليل ثم ننتقل للتطبيق

 

والله المستعان ... وهو سبحانه من وراء القصد وهو حسبي

 

...........

  • Like 2
قام بنشر

متطلبات التطبيق

لدينا في تطبيقنا من الموضوع السابق ، تنفيذ لفكرة إنشاء المجلد تبعاً لرقم الموظف

وبعد الإنشاء هذا أتيحت لنا إمكانية فتح هذا المجلد بعد التأكد من وجوده

 

يلزمنا الآن نموذج للتعامل مع هذه الفكرة و الإستمرار بتنفيذ فكرتنا الحالية

في هذا النموذج سيتاح لنا :

 

تحديد إسم المجلد (الذي يخص الموظف المعني) ، ضمن مربع نص

إختيار الملف الذي نرغب بنسخه ، ضمن مربع نص و رز أمر

تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين ، ضمن مربع نص

تحديد إسم الملف محل النقل في حال رغبتنا لإجراء أي تعديل عليه ، ضمن مربع نص

تحديد المسار النهائي وإسم الملف النهائي ، محل الإجراء ، ضمن مربع نص

 

وللحديث بقية ...

 

.....صورة مرفقة >>>.....post-12714-0-72729000-1363066166_thumb.j.....

 

.............

قام بنشر

حياك الله ابا عمر

أخي بسيط

هل يفترض أن تكون كل الإجراءات ضمن النموذج الرئيسي للموظفين !!

 

.........

قام بنشر (معدل)

الإسهاب في الشرح أحب الى القلب مع إرفاق التطبيق هذا إن لم يكن فيها إثقال عليك أستاذي الكريم حينها يُكتفى بالتطبيق _ والله _ المستعان

تم تعديل بواسطه أبا عمر
قام بنشر

حياك الله ابا عمر

أخي بسيط

هل يفترض أن تكون كل الإجراءات ضمن النموذج الرئيسي للموظفين !!

 

.........

نعم اخى الغالى اعتقد انه من الافضل ان يكون داخل  النموذج الرئيسي للموظفين

قام بنشر

هل ترغبون أن نسهب في الشرح ، أم نرفق التطبيق ... وكفى !!!

 

:cool2:

 

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

قام بنشر

نباشر وعلى بركة الله ...  اللَّهُمَّ أنت عضُدِي ونَصِيري ، بِك أَجُولُ ، وبِك أصولُ

إخوتي

 

ضمن النموذج ننفذ ما يلي :

 

تحديد إسم المجلد (الذي يخص الموظف المعني) ، ضمن مربع نص EMP NO

إختيار الملف الذي نرغب بنسخه ، ضمن مربع نص txtFile و رز أمر btnBrowse

تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين ، ضمن مربع نص txtloc

تحديد إسم الملف محل النقل في حال رغبتنا لإجراء أي تعديل عليه ، ضمن مربع نص txtFN

تحديد المسار النهائي وإسم الملف النهائي ، محل الإجراء ، ضمن مربع نص txtlocF

زر أمر لإجراء النسخ btnMove

زر أمر لفتح المجلد btnE_File

وظيفة (روتين ) لتطبيق النسخ MoveAFile

 

وللحديث بقية ...

 

..........

  • Like 1
قام بنشر

نتابع .....

 

جميع مربعات النص غير منضمة ، بإستثناء مربع نص إسم المجلد الذي يحمل رقم الموظف فمصدر صفه (رقم الموظف)

في حدث عند الحالي للنموذج ننسخ الكود 

 

 

Private Sub Form_Current()
Me.txtloc = CurrentProject.Path & "\Emp_Files"
End Sub

 

ليتم تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين

..........

قام بنشر

نتابع 

 

خلف زر الأمر btnBrowse المكلف بإظهار file dialog  ننسخ الكود

 

 

Private Sub btnBrowse_Click()' Requires reference to Microsoft Office 11.0 Object Library.


   Dim fDialog As Office.FileDialog
   Dim varFile As Variant


   ' Clear Textbox contents.
   Me.txtFile = ""
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)


   With fDialog


      ' Allow user to make multiple selections in dialog box
      .AllowMultiSelect = True
             
      ' Set the title of the dialog box.
      .Title = "Please select one or more files"


      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "All Files", "*.*"
      .Filters.Add "Joint Photographic Experts Group", "*.JPEG"
      .Filters.Add "Graphics Interchange", "*.GIF"
      .Filters.Add "Portable Network Graphics", "*.PNG"


      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then


         'Loop through each file selected and add it to our list box.
         For Each varFile In .SelectedItems
            Me.txtFile = varFile
            Me.txtFN = Split(txtFile, "\")(UBound(Split(txtFile, "\")))
            Me.txtlocF = CurrentProject.Path & "\Emp_Files\" & Me.EMP_NO & "\" & Me.txtFN
         Next


      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Sub
 

وهذا الكود مكلف أيضاً بإسناد مسار الملف المختار للحقل txtloc

 

 

            Me.txtFile = varFile

 

 

وإقتطاع إسم الملف المختار ( من إسم المسار كاملاً ) في الحقل txtFN

 

 

            Me.txtFN = Split(txtFile, "\")(UBound(Split(txtFile, "\")))

 

 

 

وتجميع إسم الملف مع إسم مجلد الموظف مع المسار الإفتراضي لمجلدات الموظفين في الحقل txtlocF

 

 

 

            Me.txtlocF = CurrentProject.Path & "\Emp_Files\" & Me.EMP_NO & "\" & Me.txtFN

 

وللحديث بقية ....

 

............

قام بنشر

نتابع

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

 

 

      .Filters.Clear
      .Filters.Add "Joint Photographic Experts Group", "*.JPEG"
      .Filters.Add "Graphics Interchange", "*.GIF"
      .Filters.Add "Portable Network Graphics", "*.PNG"

 

 

 أو إجمالها بجميع الملفات

 

 

      .Filters.Clear
      .Filters.Add "All Files", "*.*"

 

 

أو دمج الخيارين

 

 

      .Filters.Clear  
      .Filters.Add "All Files", "*.*"
      .Filters.Add "Joint Photographic Experts Group", "*.JPEG"
      .Filters.Add "Graphics Interchange", "*.GIF"
      .Filters.Add "Portable Network Graphics", "*.PNG"

 

وللحديث بقية ...

 

...........

قام بنشر

نتابع

 

كنا في الموضوع السابق قد تعرضنا للكود القابع خلف زر أمر إنشاء و / أو إظهار المجلد btnE_File

 

 

Private Sub btnE_File_Click()On Error GoTo Err_btnE_File_Click


Dim fs As Object
Dim a As Object


    Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FolderExists(Me.txtloc & "\" & Me.EMP_NO) = True Then
           ' MsgBox "Folder exists"
            Call fHandleFile(Nz(Me.txtloc & "\" & Me.EMP_NO, ""), 1)
         Else
         If MsgBox("Folder Not Found , A New Folder Will Be Created For The Employee ", vbOKCancel) = vbCancel Then
         Exit Sub
         Else
               Set a = fs.Createfolder(Me.txtloc & "\" & Me.EMP_NO)
            'MsgBox "Folder was created"
            Call fHandleFile(Nz(Me.txtloc & "\" & Me.EMP_NO, ""), 1)
         End If
         End If


Exit_btnE_File_Click:
    Exit Sub


Err_btnE_File_Click:
    MsgBox Err.Description
    Resume Exit_btnE_File_Click
    
End Sub
 

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

 

وللحديث بقية ....

 

......

قام بنشر

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

فقد أصبح لدينا مجلدات للموظفين أنشئت مقترنة بأرقامهم الوظيفية

وصار متاحاً تحديد مسار الملف المراد نسخه ، وإسمه ، بإختيار سلس هيًن 

وتم فرز إسم الملف وإضافته لإسم مجلد الموظف للمسار المفترض

وبقي لدينا مسك الختام ....

 

نسخ الملف من المسار المختار ، للملف الهدف ...

 

:dance1:  :power: 

........

قام بنشر

نتابع

 

في محرر الفيجوال للنموذج ننسخ الروتين التالي

 

 

Function MoveAFile(OldName As Variant, NewName As Variant)

If IsNull(OldName) Or IsNull(NewName) Then
MsgBox "Old or New Folder/File name not supplied to function."
Exit Function
End If
retval = 0
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(Me.txtlocF) = True Then
MsgBox "File exists"
Else
retval = objFSO.CopyFile(OldName, NewName, False) 'True
Set objFSO = Nothing
MsgBox "File has been moved."
End If


End Function

 

وخلف زر أمر إجراء النسخ btnMove  ( عند النقر ) ننسخ الكود

 

 

Private Sub btnMove_Click()Call MoveAFile(Me.txtFile, Me.txtlocF)
End Sub

 

وبإذن الله وبتوفيق منه ، يتم المراد ...

 

.............

قام بنشر

نتابع

 

تختلف الحاجات هنا بين الإبقاء على الملف الأصلي في مجلده القديم أو أن تكون الحاجة اليه إنتهت

 

فإن كنا ممن يرغب بنسخ الملف الى المجلد الجديد والإبقاء على القديم نستخدم السطر 11 من الروتين كما يلي

 

 

retval = objFSO.CopyFile(OldName, NewName, False) 'True
 

وإن كنا ممن يرغب بنقل الملف الى المجلد الجديد ولا نرغب بالإبقاء على القديم نستخدم السطر 11 من الروتين كما يلي

 

 

retval = objFSO.CopyFile(OldName, NewName, True)  

فيتم نقل الملف للمجلد الجديد ويلغى من المجلد القديم 

 

..........

وللحديث معكم بقية ... 

 

والله من وراء القصد وهو حسبي

قام بنشر

عَن أَبي الدَّردَاءِ رَضِي اللَّه عنْهُ أَنَّهُ سمِعَ رَسُولَ اللَّهِ صَلّى اللهُ عَلَيْهِ وسَلَّم يَقُولُ : (ما مِن عبْدٍ مُسْلِمٍ يَدعُو لأَخِيهِ بِظَهرِ الغَيْبِ إِلاَّ قَالَ المَلكُ ولَكَ بمِثْلٍ) رواه مسلم

وعَنْهُ أَنَّ رسُول اللَّه صَلّى اللهُ عَلَيْهِ وسَلَّم كانَ يقُولُ : (دَعْوةُ المرءِ المُسْلِمِ لأَخيهِ بِظَهْرِ الغَيْبِ مُسْتَجَابةٌ ، عِنْد رأْسِهِ ملَكٌ مُوكَّلٌ كلَّمَا دعا لأَخِيهِ بخيرٍ قَال المَلَكُ المُوكَّلُ بِهِ : آمِينَ ، ولَكَ بمِثْلٍ) رواه مسلم

قال الله تعالى‏:‏ ‏{‏
وَالَّذِينَ جَاءُوا مِنْ بَعْدِهِمْ يَقُولُونَ رَبَّنَا اغْفِرْ لَنَا وَلِإِخْوَانِنَا الَّذِينَ سَبَقُونَا بِالإِيمَانِ وَلا تَجْعَلْ فِي قُلُوبِنَا غِلًّا لِلَّذِينَ آمَنُوا رَبَّنَا إِنَّكَ رَءُوفٌ رَحِيمٌ}‏ ‏(‏‏(‏الحشر‏:‏ 10‏)‏‏)‏‏.

‏ وقال تعالى‏:‏ ‏{‏
فَاعْلَمْ أَنَّهُ لَا إِلَٰهَ إِلَّا اللَّهُ وَاسْتَغْفِرْ لِذَنْبِكَ وَلِلْمُؤْمِنِينَ وَالْمُؤْمِنَاتِ ۗ وَاللَّهُ يَعْلَمُ مُتَقَلَّبَكُمْ وَمَثْوَاكُمْ }‏ ‏(‏‏(‏محمد‏:‏ 19‏)‏‏)‏‏.‏

وقال تعالى‏:‏ إخبارًا عن إبراهيم عليه السلام ‏{‏
رَبَّنَا اغْفِرْ لِي وَلِوَالِدَيَّ وَلِلْمُؤْمِنِينَ يَوْمَ يَقُومُ الْحِسَابُ}‏ ‏(‏‏(‏إبراهيم‏:‏ 41‏)‏‏)

قام بنشر (معدل)

أسأل _ الله _ عز وجل أن يجعل ما تقدمه في موازين حسناتك يوم تلقاه 
كما أسأله أن يرضى عنك في الدينا والآخرة وأن ترى أثر ما تفعله في ذريتك وذرية ذريتك الى ما يشاء_ الله _ لك من ذرية.
وأن يغفر لك ولوالديك وآباءك أجمعين الى أبيك آدم عليه السلام
 


جزاك_الله_خيراً


 

تم تعديل بواسطه أبا عمر
قام بنشر (معدل)

تم تنفيذ كافة الخطوات ولكن زر استعراض الملفات عند الضغط عليه يعطى هذا الخطاء  كما فى الصوره

 

وهناك سؤال فى حالة الرغبه فى اضافة العديد من الملفات دفعه واحده  وكيف يمكن تعين صورة الموظف من خلال الفولدر الخاص به ؟

 

شاكر ومقدر مجهوداتك وجزاك الله خيرا

post-9510-0-13893300-1363284358_thumb.jp

تم تعديل بواسطه بسيط وكريم

Join the conversation

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

زائر
اضف رد علي هذا الموضوع....

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

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information