Snasui Excel Forum

Code: Select all

Sub EmailRange()
     
    Dim MailSelection As Object
    Dim cell As Range
    Dim Subject As String
    Dim EmailAddress As String
     
     
     
    ThisWorkbook.Sheets("FirstSheet").Range("B1:G111").Copy
     
     
     
    Set OutlookApp = CreateObject("Outlook.Application")
     
    For Each cell In _
        Columns("A").Cells
        If cell.Value Like "*@*" Then
            Subject = "Subject"
            EmailAddress = cell.Value
             
            Set MailSelection = OutlookApp.CreateItem(0)
            With MailSelection
                .To = theeranart@intriplex.co.th
                .Subject = Subject
                .Display
                SendKeys "^({v})", True
            End With
        End If
    Next
End Sub

Code: Select all

.To = theeranart@intriplex.co.th

Code: Select all

.To = "theeranart@intriplex.co.th"