Moosak

فعلا أستاذنا العزيز ،، نسخة الأكسس 2003 تكوم بكتابة الكود تلقائيا في محرر الأكواد .. بينما النسخ الأحدث منه تضيف الأمر على شكل ماكرو . 🙂

تفضل أخي هذا التعديل 🙂 : مع ملاحظة أنني قمت بتحويل حقل الصورة إلى حقل نصي بدل (إرتباط) وذلك لتجنب بعض الإشكالات في الكود . لإضافة مرفقات إضافية تكرر سطر إضافة مرفق كل مرة كما هو موضح بالكود .. لأن في الصورة لديك مرفقان بينما في برنامجك مرفق واحد .. فإذا كنت ستكتفي بمرفق واحد ألغِ سطر المرفق الإضافي .. Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.Attachments.Add Me.Imagepath.Value ' المرفقات MyMail.Attachments.Add "C:\file2.PDF" ' إضافة مرفق ثانٍ MyMail.Display ' لتشغيل برنامج الأوتلوك والتركيز عليه Set MyOutlook = Nothing Set MyMail = Nothing ارسال ايميل مع المرفق (1).rar

تفضل هذا كود تكرار السجل : 🙂 Private Sub DublicateRecBtn_Click() On Error GoTo Err_DublicateRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Exit_DublicateRecBtn_Click: Exit Sub Err_DublicateRecBtn_Click: MsgBox Err.Description Resume Exit_DublicateRecBtn_Click End Sub

خلاص هذا هو الكود اللي تحتاجه : Sub Send_Email_with_Attachment() ' You should add this library : Microsoft Outlook 16.0 Object Library Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.Attachments.Add "C:\R_Emp.pdf" ' المرفقات MyMail.Display ' لتشغيل برنامج الأوتلوك والتركيز عليه Set MyOutlook = Nothing Set MyMail = Nothing End Sub بس لأنك ما خبرتني من وين تجيب المرفق .. تأكد أنك تحط رابط المرفق مكان هذي 🙂 : "C:\R_Emp.pdf"

طيب .. هناك بعض الأمور غير موضحة لا في السؤال ولا في المرفق .. 1- لمن سترسل الرسالة ؟ ( أين ستضع إيميل من سترسل له ؟) 2- أين يوجد المرفق ؟ هل سينشئه البرنامج ثم يرسله ؟ أم أنه مرفق ثابت فقط ستضع مسار الملف في الكود ؟ 3 - هل تريد البرنامج أن يرسل تقارير جميع الطلاب ؟ أم الطالب الحالي فقط ؟ ( لأنك وضعت حلقة تمر على جميع الطلاب في الكود ) 4 - تريد أن يفتح الآوتلوك ويقف وأنت ستضغط زر الإرسال ؟ أم يرسلها تلقائيا نيابة عنك ؟ هذه البيانات مهمة لكتابة الكود 🙂

أخي @MO87 تفضل هذا كود الإرسال بالآوتلوك مع إضافة المرفقات 🙂 عليك أن تستبدل البيانات الموجودة مقابل كل بيان ( المرسل إليه ، نسخة إلى ، مسودة ، العنوان ، الموضوع ، المرفقات ) تستبدلها بأسماء الحقول عندك في النموذج .. وكذلك عليك أن تضيف المكتبة : Microsoft Outlook 16.0 Object Library Sub Send_Email_with_Attachment() ' You should add this library : Microsoft Outlook 16.0 Object Library Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.To = "ReceiverEmail@Gmail.com" ' المرسل إليه MyMail.CC = "ReceiverEmail@Gmail.com" ' نسخة إلى MyMail.BCC = "ReceiverEmail@Gmail.com" ' نسخة سرية إلى MyMail.Subject = "Email Title Here" ' عنوان الرسالة MyMail.Body = "This is a Sample Mail." ' محتوى الرسالة MyMail.Attachments.Add "C:\File1.PDF", "C:\File2.PDF" ' المرفقات MyMail.Send MsgBox "تم الإرسال بنجاح" Set MyOutlook = Nothing Set MyMail = Nothing End Sub

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

هذا الاسم يليق بك أكثر 😉 مقروناً باللقب المناسب لك (الخبير) 😊👌🏼

بما أن الأستاذ خالد قام بإحياء هذا الموضوع من جديد أحببت أن أدلو بدلوي 😁 هذه طريقتي لفصل الأرقام من النص .. والعكس نزع الحروف من بين الأرقام .. أولا : استخراج الأرقام من النص وحذف الحروف : Public Function ExtractNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If IsNumeric(L) Then r = r & L End If Next x ExtractNumbersFromText = r End Function ثانيا : اسخراج الحروف وحذف الأرقام : Public Function RemoveNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If Not IsNumeric(L) Then r = r & L End If Next x RemoveNumbersFromText = r End Function abc.rar

لاحظت شي 🙂 DoCmd.RunSQL "DELETE sanduk.yat , sanduk.DAT , sanduk.SAH FROM sanduk WHERE " & myCriteria & ";"

كذاك تبغاه الأخ سعيد ؟ 🙂 مدة عمل الموظف.rar

صارت لدي حاجة لمثل هذا .. 🙂 عندي برنامج يقوم بحفظ ملفات PDF بنفس أسماء الأشخاص حسب الموجود في الجدول .. كل شخص له ملف PDF باسمه .. لكن أحيانا يتم إدخال الاسم هكذا : " الفاضل / محمد أحمد سلامة " واللويندوز يرفض علامة الـ / في أسماء الملفات وعلامات أخرى مثل : #$%^<> حسب ما أذكر .. لذلك أنشأت دالة تقوم بتتبع هذه العلامات في الاسم قبل حفظ الملف واستبدالها بالرمز " - " أو مسافة فارغة " " (ويمكنك تحديد البديل كما تشاء ) .. بدون تغيير البيانات في الجدول طبعا .. وهذه هي الدالة التي أنشأتها .. ويمكن تعديلها حسب الحاجة وتغيير الرموز المطلوبة فيها وتعيين البديل .. Public Function RemoveSymbolsFromText(strGivenTxt As String, Optional ReplacmentTxt As String = "") As String Dim Txt As String Dim R As String R = ReplacmentTxt Txt = strGivenTxt Txt = Replace(Txt, "!", R) Txt = Replace(Txt, "@", R) Txt = Replace(Txt, "#", R) Txt = Replace(Txt, "$", R) Txt = Replace(Txt, "%", R) Txt = Replace(Txt, "^", R) Txt = Replace(Txt, "*", R) Txt = Replace(Txt, "\", R) Txt = Replace(Txt, "|", R) Txt = Replace(Txt, "/", R) Txt = Replace(Txt, ".", R) Txt = Replace(Txt, "?", R) Txt = Replace(Txt, """", R) Txt = Replace(Txt, "'", R) Txt = Replace(Txt, "<", R) Txt = Replace(Txt, ">", R) Txt = Replace(Txt, "؟", R) Txt = Replace(Txt, "~", R) Txt = Replace(Txt, "&", R) RemoveSymbolsFromText = Txt End Function وتستدعيها هكذا : RemoveSymbolsFromText(strGivenTxt, "_")

الاستعلامات تفعل ذلك .. أليس كذلك ؟ 🙂

أعتقد أن المثال الذي يريده الأخ قاسم يتعلق ببرنامج يتم توزيعه على أفرع المؤسسة في عدة مدن مختلفة .. وبعد مدة معينة يتم تجميع البيانات الموزعة على الأفرع في البرنامج الرئيسي لإدارة المؤسسة .. والمثال الذي ذكره الأستاذ @ابوخليل يعالج هذه القضية وهي فكرة إبداعية .. فقط يحتاجله بعض البهارات من الـVBA لجعل العملية تصير بشكل أوتوماتيكي 🙂 ..

انظر هنا أخي هيثم : 🙂

عدلت شي في الملف الأخير ؟

نعم يحتاج تعدل اسم الفورم الجديد في الكود أخي رعد 🙂

جربته وهو شغال معي طبيعي 🙂 أيش يطلع عندك ؟

تفضل أخي رعد 🙂 هذا الكود عند فتح التقرير : If Forms!emp!d1 = False Then Me.sname.Visible = False: Me.sname.Width = 0 If Forms!emp!d2 = False Then Me.grade.Visible = False: Me.grade.Width = 0 If Forms!emp!d3 = False Then Me.idcard.Visible = False: Me.idcard.Width = 0 If Forms!emp!d4 = False Then Me.cart1.Visible = False: Me.cart1.Width = 0 If Forms!emp!d5 = False Then Me.cart2.Visible = False: Me.cart2.Width = 0 If Forms!emp!d6 = False Then Me.cart3.Visible = False: Me.cart3.Width = 0 If Forms!emp!d7 = False Then Me.passport.Visible = False: Me.passport.Width = 0 If Forms!emp!d8 = False Then Me.blod.Visible = False: Me.blod.Width = 0 all-by-yesno.rar

أنظر لهذا المرفق أخي قاسم 🙂 يعمل بنفس الفكرة .. هذا النموذج فيه كل ما تحتاجه بداية من جلب الصور + وإنشاء المجلدات المتتالية إذا كانت غير موجودة ( يعمل لكل سجل أو موظف مجلد خاص به ) + نسخ الصورة بجانب قاعدة البيانات + إمكانية نقل البرنامج إلى أي مكان آخر مع ضمان عمل الصور + حذف الصورة من المجلد . << تضغط على الصورة لفتحها >> إدارة المرفقات.rar

الخطأ أنك كتبت اسم مربع النص في الكود هكذا : DoCmd.OpenForm "TypeNam2", , , "[ID]= " & Me.ID والصحيح أن تكتب اسم الحقل كما هو في الجدول هكذا : DoCmd.OpenForm "TypeNam2", , , "[typeID]= " & Me.ID

أنا شكلي استعجلت ودخلت بالعرض 😅

ماشي ما أحبه 😂😁

تفضل أخي @أكسس وبس 🙂 تضع هذا الكود في حدث قبل الإدراج للنموذج الفرعي ( وهو نفس كود الأستاذ جعفر بتصرف ) : Private Sub Form_BeforeInsert(Cancel As Integer) Me.Number = Nz(DMax("[Number]", "[tblName]", "[typeID] =" & [Forms]![TypeNam]![ID] & ""), [Forms]![TypeNam]![ID]) + 1 End Sub Code.rar

الحقيقة أني لم أعمل على جداول SQL سابقا وهذا الكود مخصص لفحص اتصال الجداول عندما تكون الجداول أكسس ولكن مفصولة في ملف لوحدها ... وقلت لعله يعمل على جداول SQL .. لذلك أقترح عليكِ بعدما جربتِ طريقة الأخ @حسين العربى أن تطبقي الخطوات التي ذكرها لك .. والرسالة ستكون حسب ظهور البيانات من عدمه ..