E-mailing a Workbook as an attachment, but...

[JMH022]

I have a problem on a project in the works which probably has a simple solution, but for the life of me it is stumping me. Here is the code that works:

Sub SendMail ()

‘Assumptions: User has Microsoft Outlook open, User has Excel open and a file titled ‘Book 1’ is active in Excel.

'This sends the attachment via e-mail to multiple recipients.

Windows("Book 1.xls").Activate

ActiveWorkbook.SendMail Recipients:=Array("email1@domain.com", "email2@domain.com"), Subject:=Date & _
" Subject of e-mail goes here", ReturnReceipt:=True

End Sub


‘The item is then saved in the Sent Items folder. I want to add code to be able to send the item without a copy being saved to the Sent Items folder. Any experts out there that can tell me if this is possible?

 

[Ivan F Moala]

I think the problem lies in the olMail.Attachments.Add ThisWorkbook.FullName statement. How to I reword this to send the active sheet. I tried Windows("Book1").Activate and then sending it, but it errored. Do I need to specify the actual name of the file somewhere?

Try
Activeworkbook.fullname

Ivan

 

[JMH022]

No-go. A Run time Error occurs:

"System cannot find the file specified."

See the frustration I have been going through?

 

[dk]

The code will only work if the activeworkbook has been saved. This modified code will check to see if it has. If not, it will prompt the user to save the file.

HTH,
D

Sub SendAWorkbook()
'Sends active workbook from Outlook without saving in Sent Items

'References need to the MS Outlook object library

Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim strWorkbookPath As String


'Test to see if the active workbook has been saved before.  It'll need to be before it can be sent

If ActiveWorkbook.Path = "" Then
    MsgBox "Workbook must be saved before it can be sent.", vbExclamation, "Cannot send workbook"
    strWorkbookPath = Application.GetSaveAsFilename(, "Microsoft Excel Workbook,*.xls")
    
    If strWorkbookPath = "False" Then
        MsgBox "Workbook will not be sent.", vbInformation, "Cannot send workbook"
        Exit Sub
    End If
    
    ActiveWorkbook.SaveAs strWorkbookPath
End If	

'Create Outlook application and send the mail
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = "someone@somewhere.com;someoneelse@somewhereelse.co.uk"
olMail.Attachments.Add ActiveWorkbook.FullName
olMail.Subject = "Sent automatically"
olMail.DeleteAfterSubmit = True
olMail.Send
End Sub

 

[JMH022]

dk:

That worked like a charm!

Thank you for all your help!