ماكرو VBA الذي يستخدم بيانات من مستند Word ومصنف Excel لإرسال الرسائل من Outlook


الملخص


تصف هذه المقالة ماكرو Visual Basic for Applications الذي يستخدم بيانات من مستند Microsoft Word ومصنف Microsoft Excel لإرسال الرسائل من Microsoft Outlook.

مزيد من المعلومات


توفر Microsoft الامثله علي الرسومات التوضيحية فقط ، بدون ضمان اما التعبير عنها أو تضمينها. يتضمن هذا ، ولكنه غير محدود بالضمانات الضمنية لخاص أو ملاءمة لغرض معين. تفترض هذه المقالة انك تعرف لغة البرمجة التي يتم شرحها والاداات التي يتم استخدامها لإنشاء الإجراءات وتصحيحها. يمكن ان يساعدك مهندسو الدعم في Microsoft علي شرح وظائف اجراء معين ، ولكنها لن تعدل هذه الامثله لتوفير وظائف اضافيه أو إنشاء إجراءات تفي بمتطلباتك الخاصة. يفترض المثال التالي وجود اسمين معرفين في ورقه العمل:
  • يشير الاسم الأول المعرف ، "سوبجيكتسيل" إلى خليه تحتوي علي سطر موضوع الرسالة (علي سبيل المثال ، "هذه رسالة اختبار.").
  • يشير الاسم الثاني المعرف ، "توليست" إلى الخلية الاولي في القائمة الافقيه التي تحتوي علي قائمه المستلمين (علي سبيل المثال ، "احمد Doe" و "ناجي Doe" وهكذا).
يجب ان يتوفر لديك أيضا مستند Microsoft Word. يتم استخدام نص هذا المستند بواسطة الماكرو باعتباره النص الأساسي لرسالة البريد.
Sub SendOutlookMessages() 'Dimension variables. Dim OL As Object, MailSendItem As Object Dim W As Object Dim MsgTxt As String, SendFile As String Dim ToRangeCounter As Variant 'Identifies Word file to send SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _     "file to mail, then click 'Open'", buttontext:="Send", _     MultiSelect:=False) 'Starts Word session Set W = GetObject(SendFile) 'Pulls text from file for message body MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _    End:=W.Paragraphs(W.Paragraphs.Count).Range.End) 'Ends Word session Set W = Nothing 'Starts Outlook session Set OL = CreateObject("Outlook.Application") Set MailSendItem = OL.CreateItem(olMailItem) ToRangeCounter = 0 'Identifies number of recipients for To list. For Each xCell In ActiveSheet.Range(Range("tolist"), _     Range("tolist").End(xlToRight))     ToRangeCounter = ToRangeCounter + 1 Next xCell If ToRangeCounter = 256 Then ToRangeCounter = 1 'Creates message With MailSendItem     .Subject = ActiveSheet.Range("subjectcell").Text     .Body = MsgTxt     'Creates "To" list     For Each xRecipient In Range("tolist").Resize(1, ToRangeCounter)         RecipientList = RecipientList & ";" & xRecipient     Next xRecipient     .To = RecipientList     .Send End With 'Ends Outlook session Set OL = NothingEnd Sub