Auto E-Mail an Excel File When Saved???

[Granoldad]

I have this macro to auto format and save an excel file for time/expense.

Sub SaveMyWorkbook()
 
' First range A2 is client acroynym.
' Second range B2 is billable.
' Thrid range C2 is consultant name.
' Forth range D2 is week ending.
' Fifth range is file format.
' strFolderPath = F2  "C:\1\"
' Should save as example  XYZ-B-for-John Doe-WE-112616.xlsm
 
    Dim strPath As String
    Dim strFolderPath As String
    strFolderPath = Sheet1.Range("F2").Value
    strPath = strFolderPath & _
        Sheet1.Range("A2").Value & "-" & _
        Sheet1.Range("B2").Value & "-for-" & _
        Sheet1.Range("C2").Value & "-WE-" & _
        Sheet1.Range("D2").Value & ".xlsm"
 
    ActiveWorkbook.SaveAs Filename:=strPath
 
End Sub

The file name looks something like this which works great.
XYZ-B-for-John Doe-WE-11-26-16.xlsm

Is there any way I can add to this macro or have another one that will automatically open Outlook and attach the newly saved excel file to a new email message?
I know it is a long shot although it would be even better to auto fill in the To: person?

[onlyadrafter]

Hello,

you should find a solution here

http://www.rondebruin.nl/win/section1.htm

[Granoldad]

The problem is I am trying to use certain cells that the user can change as to To:, CC:, Subject, Body etc...
This is what I was trying to do although still cannot get it to fire off an email.

Private Sub CommandButton1_Click()
sendemail
End Sub

Public Function sendemail()
On Error GoTo ende
esubject = Sheet1.Range("J3").Value
sendto = Sheet1.Range("C3").Value
ccto = Sheet1.Range("F3").Value
ebody = Sheet1.Range("M3").Value & vbCrLf & vbCrLf & Sheet1.Range("N3").Value
newfilename = Sheet1.Range("M2").Value

Set app = CreateObject("Outlook.Application")
Set itm = app.createitem(0)

With itm
.Subject = esubject
.to = sendto
.cc = ccto
.body = ebody
.attachments.Add (newfilename)
.display
.send
End With
Set app = Nothing
Set itm = Nothing


ende:
End Function

[rollis13]

Should be at least something like this:

Private Sub sendemail()

    On Error GoTo ende
    esubject = Sheets(1).Range("J3").Value
    sendto = Sheets(1).Range("C3").Value
    ccto = Sheets(1).Range("F3").Value
    ebody = Sheets(1).Range("M3").Value & vbCrLf & vbCrLf & Sheets(1).Range("N3").Value
    newfilename = Sheets(1).Range("M2").Value
     
    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)
     
    With itm
        .Subject = esubject
        .to = sendto
        .cc = ccto
        .body = ebody
        .attachments.Add newfilename
        .display
        '.send
    End With
    
ende:
    Set app = Nothing
    Set itm = Nothing

End Sub

[Granoldad]

Thanks rollis13

[rollis13]

Glad having been of some help .