מאקרו VBA המשתמש בנתונים ממסמך Word וחוברת עבודה של Excel לשליחת הודעות מ- Outlook

• חל על:

  Outlook

סיכום

מאמר זה מתאר מאקרו של Visual Basic for Applications המשתמש בנתונים ממסמך Microsoft Word וחוברת עבודה של Microsoft Excel לשליחת הודעות מ- Microsoft Outlook.

מידע נוסף

חשוב

מיקרוסופט מספקת דוגמאות תכנות להמחשה בלבד, מבלי שהאחריות מתבטאת או משתמעת. זה כולל, אך אינו מוגבל, לאחריות המשתמעת של סחירות או כושרו למטרה מסוימת. מאמר זה נכתב בהנחה שאתם מכירים את שפת התכנות המודגמת ואת הכלים המשמשים ליצירת פרוצדורות ולניפוי שגיאות. מהנדסי התמיכה של Microsoft יכולים לסייע בהסברת הפונקציונליות של פרוצדורה מסוימת, אך הם לא ישנו את הדוגמאות כדי לספק פונקציונליות נוספת או לבנות פרוצדורות שיענו על צרכיך הספציפיים.

הדוגמה הבאה מניחה שקיימים שני שמות מוגדרים בגליון העבודה:

• השם המוגדר הראשון, subjectcell, מפנה לתא המכיל את שורת הנושא של ההודעה (לדוגמה, "This is a test message".).
• השם המוגדר השני, tolist, מפנה לתא הראשון ברשימה האופקית המכיל רשימת נמענים (לדוגמה, "פלוני", "פלוני", וכן הלאה).

דרוש לך גם מסמך 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 = Nothing
    
End Sub