Email Code to Email Active XLSX sheet

blandreth

Board Regular
Joined
Jan 18, 2018
Messages
52
Hi,

I have the below code that will convert my active sheet to a .pdf file to be emailed. However, I am looking for code that will attach the active xlsx or xlsm sheet to an email.

Code:
Sub CreateEmail()
Dim olMail As Object
Dim ws As Worksheet
Dim fName As String
Dim olApp As Object
 
 
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.createItem(0)
Set ws = ActiveSheet
fName = Environ("UserProfile") & "\Desktop\” & Range(“L10”).Value & “.pdf"
ws.ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard
 
 
With olMail
    .To = ""
    .Subject = "Range(“L10”)"
    .Body = ""
    .Attachments.Add fName
    .Display 'You can change to .Send to send email instead of displaying it
End With
 
 
Kill fName
End Sub


[\code]

I appreciate the help.

Thanks,
Brian
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Try this macro:
Code:
Public Sub Email_Active_Sheet()

    Dim wb As Workbook
    Dim p As Long, tempWorkbookFullName As String
    Dim emailSubject As String
    Dim oApp As Object, oMail As Object
    
    Set wb = ActiveWorkbook
    
    With wb
        If .Path = vbNullString Then
            MsgBox "You must save the active workbook (" & .Name & ")", vbExclamation
            Exit Sub
        End If
        p = InStrRev(.FullName, ".")
        emailSubject = .ActiveSheet.Range("L10").Value
        tempWorkbookFullName = Environ("temp") & "\" & emailSubject & Mid(.FullName, p)
        .ActiveSheet.Copy
        ActiveWorkbook.SaveAs Filename:=tempWorkbookFullName, FileFormat:=.FileFormat
        ActiveWorkbook.Close False
    End With
   
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.createItem(0)
   
    With oMail
        .To = "email.address@domain"
        .Subject = emailSubject
        .Body = "This is the body of the email."
        .Attachments.Add tempWorkbookFullName
        .Display  'or .Send
    End With
    
    Kill tempWorkbookFullName
    
    Set oMail = Nothing
    Set oApp = Nothing
   
End Sub
 
Upvote 0
Try this

Code:
Sub CreateEmail()
  Dim olMail As Object, ws As Worksheet, fName As String
  Set olMail = CreateObject("Outlook.Application").createItem(0)
  Set ws = ActiveSheet
  fName = Environ("UserProfile") & "\Desktop\" & Range("L10").Value & ".xlsx"
[COLOR=#0000ff]  ws.Copy[/COLOR]
[COLOR=#0000ff]  ActiveWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbook[/COLOR]
[COLOR=#0000ff]  ActiveWorkbook.Close False[/COLOR]
  With olMail
    .To = ""
    .Subject = Range("L10")
    .Body = ""
    .Attachments.Add fName
    .Display 'You can change to .Send to send email instead of displaying it
  End With
  Kill fName
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top