Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Sep 2013
    Thanked 0 Times in 0 Posts

    Send mail body from cell value and text file


    I send mail with this script and the contents of body are cell values, now i want to add the contents of text which is in "c:\Email Contents\covering.txt". Please some guide me doing this its very important to have the contents of this text file in the mail body.
        Option Explicit
        Sub Send_Files()
        Dim OutApp As Outlook.Application
        Dim OutMail As Outlook.MailItem
        Dim sh As Worksheet
        Dim cell As Range
        Dim FileCell As Range
        Dim rng As Range
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set sh = Sheets("sendemail")
        Set OutApp = CreateObject("Outlook.Application")
            For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)
            'Enter the path/file names in the C:Z column in each row
            Set rng = sh.Cells(cell.Row, 1).Range("K1:Z1")
            If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "H").Value) = "yes" _
            And LCase(Cells(cell.Row, "I").Value) <> "send" And _
            Application.WorksheetFunction.CountA(rng) > 0 Then
               Set OutMail = OutApp.CreateItem(olMailItem)
        On Error Resume Next
            With OutMail
            .To = cell.Value
            '.CC = ""
            .Subject = "Reports & Statements "
            .Body = "Dear Sir / Madam," & vbNewLine & vbNewLine & _
                    "Status : " & cell.Offset(0, 3).Value _
                    & vbNewLine & vbNewLine & _
                    "Report No.: " & cell.Offset(0, -5).Value _
                    & vbNewLine & vbNewLine
      GetBoiler("c:\Email Contents\covering.txt")
                    For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                        If Trim(FileCell) <> "" Then
                            If Dir(FileCell.Value) <> "" Then
                                .Attachments.Add FileCell.Value
                            End If
                        End If
                    Next FileCell
                    .Display  'Or use Send
                    Application.Wait (Now + TimeValue("0:00:02"))
                End With
    On Error GoTo 0
    Cells(cell.Row, "I").Value = "send"
                Set OutMail = Nothing
            End If
        Next cell
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End Sub
    Function GetBoiler(ByVal sFile As String) As String
        Dim fso As Object
        Dim ts As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
        GetBoiler = ts.readall
    End Function

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Pittsburgh, Pennsylvania, USA
    Thanked 342 Times in 335 Posts
    Are you looking for perhaps by changing the line to:

    .Body = .Body & GetBoiler("c:\Email Contents\covering.txt")

    This will append the contents obtained by the function onto the end of the Body you had already created.


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts