email & attachment

Trevor3007

Active Member
Joined
Jan 26, 2017
Messages
495
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
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

SpillerBD

Well-known Member
Joined
Jul 2, 2014
Messages
2,706
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.


Code:
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
 

Forum statistics

Threads
1,089,200
Messages
5,406,789
Members
403,106
Latest member
AliO

This Week's Hot Topics

Top