حمدى الظابط

up

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

مشكلة عند تغير وتحديث موديول السلام عليكم ورحمة الله وبركاته الموديول الاول يرسل منه صور الى الاميل وكان يعمل بكفاءة عالية ولا يوجد مشكلة فى ذلك الموديول الاول ويتوافق مع ارسال الاميل Option Compare Database Option Explicit Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean Private Const ALLFILES = "All files" Function MakeFilterString(ParamArray varFilt() As Variant) As String Dim strFilter As String Dim intRes As Integer Dim intNum As Integer intNum = UBound(varFilt) If (intNum <> -1) Then For intRes = 0 To intNum strFilter = strFilter & varFilt(intRes) & vbNullChar Next If intNum Mod 2 = 0 Then strFilter = strFilter & "*.*" & vbNullChar End If strFilter = strFilter & vbNullChar End If MakeFilterString = strFilter End Function Private Sub InitOFN(ofn As OPENFILENAME) With ofn .hwndOwner = hWndAccessApp .hInstance = 0 .lpstrCustomFilter = vbNullString .nMaxCustFilter = 0 .lpfnHook = 0 .lpTemplateName = 0 .lCustData = 0 .nMaxFile = 511 .lpstrFileTitle = String(512, vbNullChar) .nMaxFileTitle = 511 .lStructSize = Len(ofn) If .lpstrFilter = "" Then .lpstrFilter = MakeFilterString(ALLFILES) End If .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar) End With End Sub Function OpenDialog(ofn As OPENFILENAME) As Boolean Dim intRes As Integer InitOFN ofn intRes = GetOpenFileName(ofn) If intRes Then With ofn .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1) End With End If OpenDialog = intRes End Function وبعد التحديث الى ذلك اصبح يرسل صور الى الواتساب بكفاءة ولكن لاسف اصبح لا يرسل الصور الى الاميل الموديول الثانى يرسل الى الواتساب ولا يرسل الى الاميل Option Compare Database Option Explicit Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type #If VBA7 Then Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Public Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean #Else Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean #End If #If VBA7 Then Public Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr #Else Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long #End If Private Const ALLFILES = "All files" Function MakeFilterString(ParamArray varFilt() As Variant) As String Dim strFilter As String Dim intRes As Integer Dim intNum As Integer intNum = UBound(varFilt) If (intNum <> -1) Then For intRes = 0 To intNum strFilter = strFilter & varFilt(intRes) & vbNullChar Next If intNum Mod 2 = 0 Then strFilter = strFilter & "*.*" & vbNullChar End If strFilter = strFilter & vbNullChar End If MakeFilterString = strFilter End Function Private Sub InitOFN(ofn As OPENFILENAME) With ofn .hwndOwner = hWndAccessApp .hInstance = 0 .lpstrCustomFilter = vbNullString .nMaxCustFilter = 0 .lpfnHook = 0 .lpTemplateName = 0 .lCustData = 0 .nMaxFile = 511 .lpstrFileTitle = String(512, vbNullChar) .nMaxFileTitle = 511 .lStructSize = Len(ofn) If .lpstrFilter = "" Then .lpstrFilter = MakeFilterString(ALLFILES) End If .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar) End With End Sub Function OpenDialog(ofn As OPENFILENAME) As Boolean Dim intRes As Integer InitOFN ofn intRes = GetOpenFileName(ofn) If intRes Then With ofn .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1) End With End If OpenDialog = intRes End Function اريد التعديل على الموديول ليتوافق مع ارسال الاميل والوتساب معا @ابو خليل @Moosak وجمعة مباركة تجرية.rar

up

UP

السلام عليكم ورحمة الله وبركاته الموضوع يوجد بالنموذج الموجود بالملف Form1 ارسال تقرير من قاعدة البيانات سواء بالاميل او الوتس وكود ارسال التقرير يعمل الحمد لله ولكن مشكلته انه يرسل ملف جميع الشهادات ( مجمعه بكل الاسماء لكل اسم ) والصح والاصح انه يرسل شهادة واحدة لصاحب كل سجل برقم ID الخاص به واسمه فقط 2 – كود ارسال الوتساب لايعمل ولا يرسل يحتاج الى تعديل شكرا لحضرتكم ولكم جزيل الشكر تجرية.rar

السلام عليكم هل اكمل فى نفس الموضوع كيفية ارسال تقارير عبر الوتساب ام اطرح الموضوع فى موضوع وعنوان جديد @ابو خليل

صباح الرزق والسعادة بعد اتباع التعليمات والحذف يعمل البرنامج بشكل سريع وبكفاءة عالية جدا ولا يسعنى من الكلمات غير الشكر والامتنان واعلم انى غلبتك معايا ولكنك ذو صدرا رحبم

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

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

up

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

البقاء والدوام لله ربنا يرحمه ويغفر له ويسمحه ونشاطركم الاحزان

السلام عليكم الموضوع عند الضغط على زر الوتساب اريد قراءة مربعات النص sub ومربع النص myname ومربع النص attach بنفس الترتيب الموجود فى الكود او بأى طريقة المهم يتم التعريف فى كود ارسال الوتساب ولكم جزيل الشكر rMSG = " || *" & Me.myname.Value & "*" & " ||" & vbcrlf & "|| *" & Me.msg.Value & "*" & " ||" & vbcrlf & "|| *" & Me.attach.Value & "* ||" & vbcrlf & "|| " & "المرسل : *" & Me.sub تجرية.rar

السلام عليكم اريد ان الكود يقراء مربعات النص sub ومربع النص myname ومربع النص attach بنفس الترتيب الموجود فى الكود strMSG = " || *" & Me.myname.Value & "*" & " ||" & vbcrlf & "|| *" & Me.msg.Value & "*" & " ||" & vbcrlf & "|| *" & Me.attach.Value & "* ||" & vbcrlf & "|| " & "المرسل : *" & Me.sub

up

up

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

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

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

صباح السعادة والهنا والرزق التجربة ناجحة 100% ولكن هل تسمح لى بسؤال ومجرد افتراح وهو هل فى امكانية تظل قائمة الصور مفتوحة حتى يتم الانتهاء من الاختيار بدل ما كل مره يتم الفتح ثم الاختيار ثم الفنح وهكذا ؟ ومارئيك اذا وضعنا كل الصور غى مربع واحد بمعنى ان نقسم المربع الى اربع تريع مثلا ليكون فى كل ربع صورة بدل من ان نضع ثلاث مربعات مجرد افكار ولكن استاذى الفاضل اشكرك قد وعد واوفيت خالص تحياتى وتقديرى واحترامى

صباح الخير هجرب حالا واخبرك بالنتيجة

up

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