Sending e-mail from excel

[Zahhhaaaa]

Hello again,

is it possible to send specific rows via e-mail from excel? I have some data on range a28:D46, range named as "Report". Is is possible to send ONLY this range to e-mail, or do I need to send whole workbook?

And also it would be great, if possible, that when user clicks commandbutton, messagebox will pop-up asking e-mail address and user can write down the address where wants to send e-mail.

Thank you!

 

[VoG]

You should find some suitable code here http://www.rondebruin.nl/sendmail.htm

 

[Zahhhaaaa]

It helped me! I got a code like I wanted, but didn't give me an answer that when user selects commandbutton, it asks where to send e-mail.

Is it possible that I have some sort of validation list, where I can pick up e-mail address? Attached to this code;

Sub Mail_Range()
'Working in 2000-2010
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long
    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A28:d46").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Range of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail "name@e-mail.com", _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[VoG]

Try this: changes in red

Sub Mail_Range()
'Working in 2000-2010
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long
    Dim Recipient As String
    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A28:d46").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    Recipient = InputBox("Enter e-mail address")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Range of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail Recipient, _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Zahhhaaaa]

Works great! Thank you!

 

[Zahhhaaaa]

Sorry to bother, but just one more question..

I'm doing this sheet to our company and they want it as simple as possible, so is it possible that if I have range of e-mail addressess like name1@e-mail.com, name2@e-mail.com, name3@e-mail.com, etc. Let's say these are on range a1:a3. Is is possible to use that previous code, that when user selects "send e-mail" it opens a box or some sort of list of these addresses, and user selects one?

 

[VoG]

Try

Sub Mail_Range()
'Working in 2000-2010
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim i As Long
    Dim Recipient As String
    Dim r As Range
    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A28:d46").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    Set r = Application.InputBox("Click in cell with e-mail address", Type:=8)
    Recipient = r.Value
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Range of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For i = 1 To 3
            .SendMail Recipient, _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next i
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Zahhhaaaa]

Perfect!!! Thank you so so sooooo much!!!!

 

[Zahhhaaaa]

Still one more question,

it works great, nothing's wrong, but is it possible that code won't give me an error when i press "cancel", after I've selected "send e-mail"? If I "accidentally" press "send", it opens this messagebox and then I want to cancel, it gives me an "run-time error '424". Is it possible to get rid of this error?

 

[VoG]

Sorry, at which point are you clicking Cancel?