wejdan_1

لدي كود يقوم بإرسال بطاقة تذكير للاشخاص الذين لم يكملون مهماتهم وعدا عليها اكثر من 30 يوما الكود فعال على الجيميل ولكن انا اريده للاوتلوك هل يوجد طريقة لتعديل من جيميل الى الاوتلوك بدلا من كتابة كود جديد ؟ كود تفعيل المطلوب في جيميل Dim objEmail Const cdoSendUsingPort = 2 ' Send the message using SMTP Const cdoBasicAuth = 1 ' Clear-text authentication Const cdoTimeout = 100 ' Timeout for SMTP in seconds mailServer = "smtp.gmail.com" SMTPport = 465 '25 'SMTPport = 465 mailusername = Sheets("Remind").Range("K10").Value mailpassword = Sheets("Remind").Range("K11").Value '''''''' n = Application.WorksheetFunction.CountA(Sheets("Search").Range("n:n")) - 1 m = Sheets("Search").Range("M4").Value - 30 For i = 1 To n If Sheets("Search").Range("r6").Offset(i, 0).Value = m Then ' Sheets("Search").Range("M5").Value Sheets("Remind").Range("g4").Value = Sheets("Search").Range("h6").Offset(i, 0).Value Sheets("Remind").Range("g6").Value = Sheets("Search").Range("m6").Offset(i, 0).Value Sheets("Remind").Range("g13").Value = Sheets("Search").Range("n6").Offset(i, 0).Value Sheets("Remind").Range("g15").Value = Sheets("Search").Range("o6").Offset(i, 0).Value mailto = Sheets("Search").Range("n6").Offset(i, 0).Value & "@gmail.com" mailSubject = Sheets("Remind").Range("J4").Value mailBody = Sheets("Remind").Range("f4").Value & " - " & Sheets("Remind").Range("G4").Value & " / " & Sheets("Remind").Range("f6").Value & " - " & Sheets("Remind").Range("G6").Value _ & " / " & Sheets("Remind").Range("F13").Value & " - " & Sheets("Remind").Range("G13").Value & " / " & Sheets("Remind").Range("F15").Value & " - " & Sheets("Remind").Range("G15").Value Set objEmail = CreateObject("CDO.Message") Set objConf = objEmail.Configuration Set objFlds = objConf.Fields With objFlds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword .Update End With ''المرفقات''' ThisWorkbook.Sheets("Remind").[tbl].ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=ThisWorkbook.Path & "\" & Sheets("Search").Range("h6").Offset(i, 0).Value, OpenAfterPublish:=False attach = Sheets("Remind").Range("K13").Value & "\" & Sheets("Search").Range("h6").Offset(i, 0).Value & ".Pdf" 'MsgBox attach objEmail.To = mailto objEmail.From = mailusername objEmail.Subject = mailSubject objEmail.TextBody = mailBody objEmail.AddAttachment attach objEmail.CC = Sheets("Remind").Range("L7").Value objEmail.BCC = Sheets("Remind").Range("L8").Value objEmail.Send Set objFlds = Nothing Set objConf = Nothing Set objEmail = Nothing End If Next i MsgBox "تم ارسال الايميلات الجديدة", vbInformation, "ايميلات" End Sub مشاركة مكررة ... تم بالفعل حذف المشاركة الأخرى , انتبه من فضلك لذلك