Excel and E-mail

[poleary2000]

Hello all. Is it possible to due the following?

I have three cells. Inside these cells will be a persons name (or it will be blank). If there is a name in the cell I want the active sheet to be emailed to the name in the cell. But I would like it to e-mail to the first intial + last name@acme.com.

Example: Name = John Doe

Active sheet is sent to jdoe@acme.com

It would then send the sheet to all three (or how ever many) names.

Is this possible? If so, anyone have any quick code to do it?

[poleary2000]

I would like to send the active sheet as an attachment. Sorry for neglecting to include that.

[Mark O'Brien]

Something like this should work:

  Dim sEmail As String

  

  With Sheets("Sheet1")

    sEmail = Mid(.Range("A1").Value, 1, 1) & .Range("A2").Value & "@acme.com"

  End With

  

  ThisWorkbook.SendMail Recipients:=sName, Subject:="Blah"

HTH

(I haven't tested this, but it should work)

[poleary2000]

I believe this will send the entire work book as an attachment?? I would like to send just the active worksheet as an attachment.

[dk]

Hello,

This should work:-

Sub SendSheet()
Dim strEmailAdd As String, lngRow As Long
'Assume that addresses are in A1:A3

For lngRow = 1 To 3
    If Cells(lngRow, 1) <> "" Then
        strEmailAdd = Left(Cells(lngRow, 1), 1) & Right$(Cells(lngRow, 1), Len(Cells(lngRow, 1)) - InStr(1, Cells(lngRow, 1), " ")) & "@acme.com"
        ActiveSheet.Copy
        ActiveWorkbook.SendMail strEmailAdd, "Your copy of worksheet x"
        ActiveWorkbook.Close False
    End If
Next lngRow
End Sub

HTH,
Dan

[poleary2000]

[poleary2000]

DK,

Great suggestion!

Your solution...does it send three different e-mails? Can it be changed to send just one e-mail with three recipients? Also, I made a mistake in my first post. The names will actually look like this inside the cells:

Doe, John

I see that your concatentation formula is very complicated. Can you rewrite it for me to account the the last minue quirk I just through in? I apologize for the inaccurate information.

Thanks for your help so far.

[dk]

Hello,

This should be what you need. Let me know if not. I've tried to make the code a bit more readable as well.


Dan

Sub SendSheet()
Dim strRecipients(1 To 3), lngRow As Long, strAdd As String, strCell As String
'Assume that addresses are in A1:A3

For lngRow = 1 To 3

    strCell = Cells(lngRow, 1)

    If strCell <> "" Then

        strAdd = Mid(strCell, InStr(1, strCell, " ") + 1, 1)    'Gets the J of Doe, John
        strAdd = strAdd & Left$(strCell, InStr(1, strCell, ",") - 1) 'Makes it JDoe
        strAdd = strAdd & "@acme.com"    'Makes it JDoe@Acme.com
        strRecipients(lngRow) = strAdd
    End If
Next lngRow

ActiveSheet.Copy
ActiveWorkbook.SendMail strRecipients, "Your copy of worksheet x"
ActiveWorkbook.Close False


End Sub

[poleary2000]

Thanks a million!