Email Selected Excel Sheets - Not Whole Workbook

Have you actually gotten this to work?  
I can't get it to go.
I get an error message:  The "SendUsing" configuration value is invalid.

I'm using Oulook.

Any ideas?

Also - I need the user to be able to choose sheet names from a listbox so the proper sheets are sent.  I didn't see anything on the link that addressed this.

I assume that a listbox with the available sheet names could work one of two ways.
1) use multi-select and a command button
2) use the _Click method of the first listbox that will populate a second listbox with the desired sheets, then a command button to send the email.

Also - The user will need to send multiple emails to several different people.  I need a way to attach the file to an open Outlook email form that will allow the user to input the names of the desired recipients (or some way to achieve the desired result of letting the user choose who to send each file to).  The example in your link had email addresses hard coded.

Thanks.

I got this sub from an EE search a while back, I don't remember the author, but it works great;

Sub SendMail()
    Dim source As Range
    Dim ColumnCount As Long
    Dim FirstColumn As Long
    Dim ColumnWidthArray() As Double
    Dim lIndex As Long
    Dim lCount As Long
    Dim dest As Workbook
    Dim i As Long
    Dim strdate As String
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    strTo = "first@emailaddress.com;second@emailaddress.com"
 
    Sheets("Summary").UsedRange.Select
    Set source = Nothing
    On Error Resume Next
    Set source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If source Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
        Exit Sub
    End If
    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If
 
    Application.ScreenUpdating = False

    ColumnCount = Selection.Columns.Count
    FirstColumn = Selection.Cells(1).Column - 1
    ReDim ColumnWidthArray(1 To ColumnCount)
    lIndex = 0
    For lCount = 1 To ColumnCount
        If Columns(FirstColumn + lCount).Hidden = False Then
            lIndex = lIndex + 1
            ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
        End If
    Next lCount

    Set dest = Workbooks.Add(xlWBATWorksheet)
    source.Copy
    With dest.Sheets(1)
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        For i = 1 To lIndex
            .Columns(i).ColumnWidth = ColumnWidthArray(i)
        Next
    End With
   
    strdate = Format(Now, "ddd, dd-mmm-yyyy")
 
    strbody = "FileName " & strdate
   
    With dest
        .SaveAs strdate
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        With OutMail
            .To = strTo
            .Subject = "Subject " & strdate
            .Body = strbody
            .Attachments.Add dest.FullName
            .Send   'or use .Display
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub

BTognietti,

The code looks good, but looks like it only applies to one sheet and not when multiple sheets are selected (in fact there is an error message when multiple sheets are selected).

I need the user to be able to select multiple sheets and send them to and individual or group via email.

In my example above I tried to throw out the idea of using a listbox to enumerate all sheets and use multi-selection in the listbox to allow the user to select the sheets desired in the email.

Then the user can press the command button to begin the email process.

The other point of concern, however, is that the user is sending each sheet or combination of sheets to a different user.  This requires that the user is able to select (dynamically) who each email is sent to.

This may require tapping into the address book in Outlook (since I did not include that in the question, I won't make it a requirement now - I'll post a different question for that).

I think this is headed the right direction - I actually tried it and it sent the email.

My guess is that I need to create the Outlook object like you did and apply it to the link that ampapa sent in the first response.

If that is the case, the only thing left would be to get some code for selecting the worksheets to be sent (in some dynamic way like the listbox I mentioned above) and then put all the code together.

Thanks - Wileecoy.

Guys,

I'm having problems copying multiple sheets dynamically (from link in first comment).  If I hard code them in it works, if I try to do anything with a string variable that mimics the exact text that is hard coded, it gives me an error - "Subscript out of range".

Any ideas on that, or any other ideas on putting together something that will allow me to dynamically select multiple sheets to copy?

I did get the email to work once the files are correctly selected.

Thanks - Norm.

To select multiple worksheets use the Sheets method. You can enumerate the worksheets collection as an array ie Sheets(n)
Regards,
John T

jjjtuohy,

Thanks for posting code.  My problem at this point is more in my last posted comment of sending multiple sheets dynamically.

You posted a comment indicating to send an array.  Can you show me the code that would work.  I try it and still get 'Subscript out of range' errors.

Thanks - Wileecoy.

<<'Subscript out of range' >>
The Sheets array is one based not zero based.

eg to place the list of sheet names in column 1 of the first sheet:

For N = 1 To Sheets.Count
   Sheets(1).Cells(N, 1).Value = Sheets(N).Name
Next N

Regards,
John T

jjjtuohy,

I changed to 1 based - I still get the same error message.  Let me post my code and you all can let me know where I went wrong.

_______________________________________________________________

Sub cbSendEmail_Click()
    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim WBname As String
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
 
    Application.ScreenUpdating = False
    Set WB1 = ActiveWorkbook

    'To get list of selected sheets
    Dim i As Integer
    Dim strText(9) As String        'only 8 worksheets in the file

    iCount = 1
    For i = 1 To (lbSheets.ListCount - 1)
        If lbSheets.Selected(i) = True Then
            strText(iCount) = lbSheets.List(i)
            iCount = iCount + 1
        End If
    Next i
   
    Sheets(Array(strText)).Copy
   
    Set WB2 = ActiveWorkbook
 
    ' It will save the new file with the ActiveSheet in C:/ with a Date and Time stamp
    WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
    WB2.SaveAs "C:/" & WBname
     
    With WB2
        .SaveAs WBname
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        With OutMail
            .To = "email@aol.com"
            .CC = "email@aol.com"
            .BCC = "email@aol.com"
            '.From = "email@aol.com"
            .Subject = "Subject: " & WBname
            .Body = "Filename: " & WB2.Name 'strbody
            .Attachments.Add WB2.FullName
            .Send   'or use .Display
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With

    Set WB1 = Nothing
    Set WB2 = Nothing
    Application.ScreenUpdating = True

End Sub

I assume you set references to outlook library.
Can you send the wbk to me because there are controls missing eg lbSheets
admin "at" HomeComputingSolutions "dot" ie
You may need to use Sheets(n).name where n is the sheet index number.

Instead of  .Attachments.Add WB2.FullName you can use multiple instances of  .Attachments.Add

The base code that works perfectly is:Sub Mail_ActiveSheet_Outlook_click()
Dim OutApp As Object
    Dim OutMail As Object
    Dim wb As Workbook
    Dim strdate As String
    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    Set wb = ActiveWorkbook
    With wb
        .SaveAs "Part of " & ThisWorkbook.Name _
              & " " & strdate & ".xls"
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "xxxxxxx@yyyyyy.net"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add wb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


John T

The line: "ActiveSheet.Copy" still only copies one sheet into the file you are sending.

I'm trying to send multiple sheets, not just the active one.  That is my only remaining problem.  The rest of the code works ok.

In fact, if I hard code the line: "Sheets(Array("Sheet1", "Sheet3", "Sheet7")).Copy" it works, I just can't send it dynamically with variables.

Thanks,

Wileecoy (a/k/a still in need)

Have you tried enumerating the sheets collection and equating to a string array?

dim name_string()
redim  name_string(Sheets.Count)


For N = 1 To Sheets.Count
   set name_string(n)= Sheets(N).Name
etc etc
Next N

print routine........................

For P = 1 To Sheets.Count
   set name_string(P)= nothing
etc etc
Next P

Regards,
John t

Ok - that isn't really working either.

Maybe you can help me do it one sheet at a time.

Something like the following in a For Next loop:
Sheet("sheet1").copy  ' puts it to a new sheet.
Sheet("sheet2").copy after:=Sheet("sheet1")

I actually have tried to do that, but the 'copy after' doesn't seem to go from one workbook to the other - it appears (by examples in help and by having problems with the code) that it is only for moving sheets within the same file.  I was hoping that I'm missing something.

My deal is this:
1.  I know what sheets are to be email becuase the user selected them in a listbox
2.  I can loop through and get each of those sheets
3.  I can send any single sheet to a new workbook with Sheet("SheetName").copy
4.  I can save the file, mail the file, close the file
5.  I cannot seem to send multiple sheets to a new workbook unless I a) hard code them or b) pre-determine them (I need to allow user to choose which sheets get emailed and they may not be the same sheets each time).

This seems like it should be possible, but is turning into more than I anticipated.

No. Do copy, print, delete and then repeat
J

jjjtuohy,

I don't want to print, I want to email.  Maybe I don't understand.

Wileecoy