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 :beerchug: .