Extract & Email As Attachment

Sub Send_Mail()


'// Assumes the ten names are in column A, and data 
        ' starts in column B
'// Assumes you have selected the cell containing the 
        ' name you wish to extract data and send the email for


'// You'll need to add a reference to "Microsoft Forms 2.0 Object Library" 
        ' if you want to use the outlook method to send mail
'// in the VBE, go to tools > references, and then check the box and click OK.


Dim x as Integer
Dim y as Integer
Dim currentrow as Integer
Dim strData as String
Dim strName as String


strName = Selection.Value
currentrow = Selection.Row


For x = 2 to 100 ' or 2 to however many cols of data you have


 strData = strData & " " & Cells(currentrow, x).Value


next x ' when loop is finished strData contains all data in one string




'/// now, you usually have two options for emailing - outlook, and CDO


'/// CDO method (does not pop up the outlook "A program is trying to 
          ' send mail on your behalf" confirmation message.  CDO bypasses 
          ' outlook completely, and can be used if outlook is not installed.)


    Dim iMsg As Object
    Dim iConf As Object
    Dim Flds As Variant


    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")


        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.yourserverhere.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ' usually 25
            .Update
        End With


    With iMsg
        Set .Configuration = iConf
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .From = "[email protected]"
        .Subject = "Report for:" & " " & strName
        .TextBody = strData ' this is the data string from above
        .Send
    End With


    Set iMsg = Nothing
    Set iConf = Nothing




'/// and here is the outlook method (just remember to remove or comment 
           ' out whichever method you're not using or you'll get two messages sent)


Dim OutApp As Object
Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Report for:" & " " & strName
        .Body = strData
        .Send   'or use .Display
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing


end sub