أبو آدم

قيد التنفيذ ....... ...........

لتفادي الخطأ إستخدم المراجع حسب الصورة .............

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

برجاء إعادة تنسيق المشاركة ... لطفاً ........

أحسن الله اليك أخي أيمن عبادي نعم صحيح فكرتك تؤتي نتائج طيبة .....

هذه بوابة لما تفكر به وهناك المزيد Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate "http://www.google.co.uk" Do While .ReadyState <> 4: DoEvents: Loop With .Document.Forms(0) .q.Value = "officena" End With .Document.f.Submit Debug.Print .Document.Body.outerText End With

حبذا لو شاركت إخوتك بما وصلت اليه ... كما شاركتهم بالسؤال ..

جزيت خيراً على طيب الدعاء أخي عبدالله ..........

ثانياً كل التحية و التقديرللأستاذ عبدالله المجرب وعليكم السلام ورحمة الله وبركاته إن سمح لي بمساهمة بسيطة ... فكل الطرق تؤدي الى روما ..... إجعل مصدر الصف لمربع التحرير و السرد من حقلين الأول الإسم والثاني الرقم ، وقم باظهار اللإسم فقط (عدد الاعمدة = 1) في حدث بعد التحديث لمربع التحرير و السرد نكتب الكود التالي Private Sub id_AfterUpdate() Me.stra1 = Me.id.Column(1) End Sub وللتطبيق حديث .. المرفق 2003 و 2007 NA_ComboAndText.rar

أولاً : دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 ..............

نسخ الملفات بين المجلدات تفصيل وتأصيل ... متابعة لطلب الأخ بسيط وكريم تحليل وتطبيق العبد الفقير لرحمة ربه نارت لبزو / أبو آدم http://www.officena.net/ib/index.php?showtopic=45856 ..............

عَن أَبي الدَّردَاءِ رَضِي اللَّه عنْهُ أَنَّهُ سمِعَ رَسُولَ اللَّهِ صَلّى اللهُ عَلَيْهِ وسَلَّم يَقُولُ : (ما مِن عبْدٍ مُسْلِمٍ يَدعُو لأَخِيهِ بِظَهرِ الغَيْبِ إِلاَّ قَالَ المَلكُ ولَكَ بمِثْلٍ) رواه مسلم وعَنْهُ أَنَّ رسُول اللَّه صَلّى اللهُ عَلَيْهِ وسَلَّم كانَ يقُولُ : (دَعْوةُ المرءِ المُسْلِمِ لأَخيهِ بِظَهْرِ الغَيْبِ مُسْتَجَابةٌ ، عِنْد رأْسِهِ ملَكٌ مُوكَّلٌ كلَّمَا دعا لأَخِيهِ بخيرٍ قَال المَلَكُ المُوكَّلُ بِهِ : آمِينَ ، ولَكَ بمِثْلٍ) رواه مسلم قال الله تعالى‏:‏ ‏{‏وَالَّذِينَ جَاءُوا مِنْ بَعْدِهِمْ يَقُولُونَ رَبَّنَا اغْفِرْ لَنَا وَلِإِخْوَانِنَا الَّذِينَ سَبَقُونَا بِالإِيمَانِ وَلا تَجْعَلْ فِي قُلُوبِنَا غِلًّا لِلَّذِينَ آمَنُوا رَبَّنَا إِنَّكَ رَءُوفٌ رَحِيمٌ}‏ ‏(‏‏(‏الحشر‏:‏ 10‏)‏‏)‏‏. ‏ وقال تعالى‏:‏ ‏{‏فَاعْلَمْ أَنَّهُ لَا إِلَٰهَ إِلَّا اللَّهُ وَاسْتَغْفِرْ لِذَنْبِكَ وَلِلْمُؤْمِنِينَ وَالْمُؤْمِنَاتِ ۗ وَاللَّهُ يَعْلَمُ مُتَقَلَّبَكُمْ وَمَثْوَاكُمْ }‏ ‏(‏‏(‏محمد‏:‏ 19‏)‏‏)‏‏.‏ وقال تعالى‏:‏ إخبارًا عن إبراهيم عليه السلام ‏{‏رَبَّنَا اغْفِرْ لِي وَلِوَالِدَيَّ وَلِلْمُؤْمِنِينَ يَوْمَ يَقُومُ الْحِسَابُ}‏ ‏(‏‏(‏إبراهيم‏:‏ 41‏)‏‏)

نتابع تختلف الحاجات هنا بين الإبقاء على الملف الأصلي في مجلده القديم أو أن تكون الحاجة اليه إنتهت فإن كنا ممن يرغب بنسخ الملف الى المجلد الجديد والإبقاء على القديم نستخدم السطر 11 من الروتين كما يلي retval = objFSO.CopyFile(OldName, NewName, False) 'True وإن كنا ممن يرغب بنقل الملف الى المجلد الجديد ولا نرغب بالإبقاء على القديم نستخدم السطر 11 من الروتين كما يلي retval = objFSO.CopyFile(OldName, NewName, True) فيتم نقل الملف للمجلد الجديد ويلغى من المجلد القديم .......... وللحديث معكم بقية ... والله من وراء القصد وهو حسبي

نتابع في محرر الفيجوال للنموذج ننسخ الروتين التالي 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 وبإذن الله وبتوفيق منه ، يتم المراد ... .............

في هذه المرحلة نكون قد قطعنا شوطاً طيباً نحو غايتنا فقد أصبح لدينا مجلدات للموظفين أنشئت مقترنة بأرقامهم الوظيفية وصار متاحاً تحديد مسار الملف المراد نسخه ، وإسمه ، بإختيار سلس هيًن وتم فرز إسم الملف وإضافته لإسم مجلد الموظف للمسار المفترض وبقي لدينا مسك الختام .... نسخ الملف من المسار المختار ، للملف الهدف ... ........

نتابع كنا في الموضوع السابق قد تعرضنا للكود القابع خلف زر أمر إنشاء و / أو إظهار المجلد 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 حيث يقوم بتفقد وجود المجلد بإستخدام إقتران المسار المفترض مع رقم الموظف ، فيقوم بفتحه حال وجوده ، أو إنشاء حال عدم وجوده. وللحديث بقية .... ......

نتابع نستطيع هنا في الكود المفصل في المشاركة السابقة (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" وللحديث بقية ... ...........

نتابع خلف زر الأمر 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 وللحديث بقية .... ............

نتابع ..... جميع مربعات النص غير منضمة ، بإستثناء مربع نص إسم المجلد الذي يحمل رقم الموظف فمصدر صفه (رقم الموظف) في حدث عند الحالي للنموذج ننسخ الكود Private Sub Form_Current() Me.txtloc = CurrentProject.Path & "\Emp_Files" End Sub ليتم تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين ..........

نباشر وعلى بركة الله ... اللَّهُمَّ أنت عضُدِي ونَصِيري ، بِك أَجُولُ ، وبِك أصولُ إخوتي ضمن النموذج ننفذ ما يلي : تحديد إسم المجلد (الذي يخص الموظف المعني) ، ضمن مربع نص EMP NO إختيار الملف الذي نرغب بنسخه ، ضمن مربع نص txtFile و رز أمر btnBrowse تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين ، ضمن مربع نص txtloc تحديد إسم الملف محل النقل في حال رغبتنا لإجراء أي تعديل عليه ، ضمن مربع نص txtFN تحديد المسار النهائي وإسم الملف النهائي ، محل الإجراء ، ضمن مربع نص txtlocF زر أمر لإجراء النسخ btnMove زر أمر لفتح المجلد btnE_File وظيفة (روتين ) لتطبيق النسخ MoveAFile وللحديث بقية ... ..........

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

حياك الله ابا عمر أخي بسيط هل يفترض أن تكون كل الإجراءات ضمن النموذج الرئيسي للموظفين !! .........

متطلبات التطبيق لدينا في تطبيقنا من الموضوع السابق ، تنفيذ لفكرة إنشاء المجلد تبعاً لرقم الموظف وبعد الإنشاء هذا أتيحت لنا إمكانية فتح هذا المجلد بعد التأكد من وجوده يلزمنا الآن نموذج للتعامل مع هذه الفكرة و الإستمرار بتنفيذ فكرتنا الحالية في هذا النموذج سيتاح لنا : تحديد إسم المجلد (الذي يخص الموظف المعني) ، ضمن مربع نص إختيار الملف الذي نرغب بنسخه ، ضمن مربع نص و رز أمر تحديد مسار المجلد الرئيسي الخاص بمجلدات الموظفين ، ضمن مربع نص تحديد إسم الملف محل النقل في حال رغبتنا لإجراء أي تعديل عليه ، ضمن مربع نص تحديد المسار النهائي وإسم الملف النهائي ، محل الإجراء ، ضمن مربع نص وللحديث بقية ... .....صورة مرفقة >>>.......... .............

انظر الرابط .... http://www.officena.net/ib/index.php?showtopic=45856 لاستكمال الحوار

في الموضوع المطروح على الرابط .... http://www.officena.net/ib/index.php?showtopic=45643 تمت الإجابة على موضوع إنشاء الملجلدات برقم الموظف وآثرت إستكمال الردّ على تشعب الأسئلة ، بموضوع جديد تحقيقاً لشروط المنتدى وهنا سنتحدث ونطبق آلية نسخ و نقل الملفات بين المجلدات حيث سنقوم ببناء الروتين بعد التحليل ثم ننتقل للتطبيق والله المستعان ... وهو سبحانه من وراء القصد وهو حسبي ...........