Help with VBA to Send Email (Ron de Bruin)

[oscark37]

This code is working almost perfectly. It creates the 50 or so emails, but I have to manually select each email and click send. It would be great to send automatically. Any ideas?

Thanks,

Oscar

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2013
'For Tips see: [URL="http://www.rondebruin.nl/win/winmail/Outlook/tips.htm"]http://www.rondebruin.nl/win/<wbr>winmail/Outlook/tips.htm[/URL]
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    TempFilePath = Environ$("temp") & "\"
 
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
   Else
        'You use Excel 2007-2013
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set OutApp = CreateObject("Outlook.<wbr>Application")
 
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("X1").Value Like "?*@?*.?*" Then
 
            sh.Copy
            Set wb = ActiveWorkbook
 
            TempFileName = "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
            Set OutMail = OutApp.CreateItem(0)
 
            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
 
                On Error Resume Next
                With OutMail
                    .to = sh.Range("X1").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "OPEN ORDER REPORT"
                    Dim strbody As String
   .body = "Hello," & vbNewLine & vbNewLine & _
              "Attached please find this week's open order and status reports." & vbNewLine & _
              "Please review and be sure to reply by Wednesday." & vbNewLine & vbNewLine & _
              "If an order is yellow, it is late." & vbNewLine & _
              "If an order is blue, it is in transit." & vbNewLine & _
              "If an order is pink, only partials sent." & vbNewLine & _
              "If an order is purple, sending overage." & vbNewLine & _
              "If an order text is brown, it needs confirmation sent." & vbNewLine & _
              "" & vbNewLine & _
              "Thank you," & vbNewLine & _
              "a@a.com
                    .Attachments.Add wb.FullName
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                    .Attachments.Add sh.Range("Y1").Value
                    .Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"   'or use .Display
                End With
                On Error GoTo 0
 
                .Close savechanges:=False
            End With
           
            Set OutMail = Nothing
 
            Kill TempFilePath & TempFileName & FileExtStr
 
        End If
    Next sh
 
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Jaguerrhye]

After you set all the properties of OutMail you want to set such as to, CC, BCC, body etc., I believe you can just use the Send method to send the email.

i.e.

.Send