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