email & attachment

[Trevor3007]

good evening,

can someone help me with some VB to send to a certain email (ie me@me.com) and attach the worksheet (sheet1)

Thank you all for your time and assistance.

KR
trevor3007

 

[SpillerBD]

This should work only with the OUTLOOK client, not the Web Version of Outlook.
I would not use the ".TO = ..." line myself so that it remains more flexible. I did add it so you would see how.
This macro makes the creation and attaching of the new file from the sheet easy.
I use the .Display method instead which allows for any additional comments to be added as well as assigning the receivers. Using the .Send would mean it would send immediately. You could use .Save which creates a draft message.

Sub EmailActiveWorksheet()

Dim OutlookApp As Outlook.Application
Dim DisplayStatusBar As Boolean
Dim DestinationPath As Variant
Dim fileName As String
Dim NewFileName As String
Dim ws As Worksheet

Set ws = ActiveWorkbook.Worksheets(ActiveSheet.Name)
NewFileName = ActiveSheet.Name & ".xlsx"


    ActiveWorkbook.Worksheets(ActiveSheet.Name).Copy
    ActiveWorkbook.Worksheets(ActiveSheet.Name).SaveAs "C:\TempM\" & NewFileName
    ActiveWorkbook.Close False
    
'Set Email Info
    Set OutlookApp = New Outlook.Application
      Msg = "Dear " & Recipient & vbCrLf & vbCrLf _
        & "Here's a copy Worksheet " _
        & "" _
        & "" & vbCrLf & vbCrLf _
        & "Thanks for your help." ' demonstrates internal carriage return line feed
        
'Create Mail Item and send it
      Set MItem = OutlookApp.CreateItem(olMailItem)
      With MItem
        '.To = WS.Range("A1").Value  ' Each worksheet to be sent should have
                                    ' SendTo Email information in Cell A1
                                    ' Multiple Email addresses seperated
                                    ' By semi-colons.
        .Subject = "WorkSheet Copy "
        .Body = Msg
        .To = "me@me.com"
        .Attachments.Add ("C:\TempM\" & NewFileName)
        '.Send 'Send immediately
        .Display 'Save to Drafts folder
      End With
      Kill "C:\TempM\" & NewFileName ' Deletes Each filename after use.
                        ' To keep files comment out the Kill statement.



End Sub