Save .xlsm as .xlsx and attach to email

wpryan

Well-known Member
Joined
May 26, 2009
Messages
534
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I'm looking for some code that will save the Macro enabled file that I have open to .xlsx format and attach it to an email. Further, I would like to do it on the "Before Cose" event, with a message box advising them that the email will be prepared and go forward with the script in the case of Yes or cancel the Close event in the case of Cancel.

I appreciate any help.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
See below.

This code will go in the ThisWorkbook module:

VBA Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim ans As Integer

ans = MsgBox("Notice!" & vbCrLf & vbCrLf & "You are about to email this file. " & _
            "Continue?", vbInformation + vbYesNo, "Email Pending")
           
If ans = vbNo Then Exit Sub

Call SaveAndMail
           
End Sub

Then, add the below to a normal (non-sheet affiliated) module by right-clicking and inserting the Module:

VBA Code:
Sub SaveAndMail()

'called from Workbook_BeforeClose() event

'uses a folder titled "Temp" to store the xlsx file
   
    Dim fPath As String: fPath = ThisWorkbook.Path
    Dim tFold As String: tFold = fPath & "\" & "Temp"

'Checks if temp folder exists; if not, it will be created
   
    If FolderExist(tFold) = False Then
        MkDir tFold
    End If

'saves copy to xlsx
   
    ThisWorkbook.savecopyas tFold & "\EmailFile.xlsx"

'loads email
'**Ensure you have the reference "Microsoft Outlook 16.0 Object Library"
'  added in Tools>References

    Dim oApp As Outlook.Application: Set oApp = CreateObject("Outlook.Application")
    Dim oMail As Outlook.MailItem: Set oMail = oApp.CreateItem(olMailItem)

'Fill quotes with your details

    With oMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add tFold & "\" & "EmailFile.xlsx"
        .Display 'or use .Send to send without displaying (subject to Trust Center settings)
    End With

'You can also automatically delete the xlsx file after the email was sent
'BUT... do not use this if you are only displaying the email

    'Kill tFold & "\" & "EmailFile.xlsx"

End Sub

Function FolderExist(folderPath) As Boolean
    FolderExist = Dir(folderPath, vbDirectory) <> ""
End Function
 
Upvote 0
Solution
See below.

This code will go in the ThisWorkbook module:

VBA Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim ans As Integer

ans = MsgBox("Notice!" & vbCrLf & vbCrLf & "You are about to email this file. " & _
            "Continue?", vbInformation + vbYesNo, "Email Pending")
          
If ans = vbNo Then Exit Sub

Call SaveAndMail
          
End Sub

Then, add the below to a normal (non-sheet affiliated) module by right-clicking and inserting the Module:

VBA Code:
Sub SaveAndMail()

'called from Workbook_BeforeClose() event

'uses a folder titled "Temp" to store the xlsx file
  
    Dim fPath As String: fPath = ThisWorkbook.Path
    Dim tFold As String: tFold = fPath & "\" & "Temp"

'Checks if temp folder exists; if not, it will be created
  
    If FolderExist(tFold) = False Then
        MkDir tFold
    End If

'saves copy to xlsx
  
    ThisWorkbook.savecopyas tFold & "\EmailFile.xlsx"

'loads email
'**Ensure you have the reference "Microsoft Outlook 16.0 Object Library"
'  added in Tools>References

    Dim oApp As Outlook.Application: Set oApp = CreateObject("Outlook.Application")
    Dim oMail As Outlook.MailItem: Set oMail = oApp.CreateItem(olMailItem)

'Fill quotes with your details

    With oMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add tFold & "\" & "EmailFile.xlsx"
        .Display 'or use .Send to send without displaying (subject to Trust Center settings)
    End With

'You can also automatically delete the xlsx file after the email was sent
'BUT... do not use this if you are only displaying the email

    'Kill tFold & "\" & "EmailFile.xlsx"

End Sub

Function FolderExist(folderPath) As Boolean
    FolderExist = Dir(folderPath, vbDirectory) <> ""
End Function
Hello, thanks for your response. I am getting errors on the lines:
VBA Code:
    Dim oApp As Outlook.Application: Set oApp = CreateObject("Outlook.Application")
    Dim oMail As Outlook.MailItem: Set oMail = oApp.CreateItem(olMailItem)
For both lines I get "User-defined type not defined" on the "Dim oApp as Outlook.Application" and "Dim oMail as Outlook.MailItem" parts, respectively. If I Dim oApp and oMail as Objects (which I'm doing blind - I don't know if it the correct thing to do), then I don't get those errors, but I get a "Variable not defined" for oMailItem.
 
Upvote 0
Hi. Did you go into Tools>References and add "Microsoft Outlook 16.0 Object Library"?
 
Upvote 0
Hi. Did you go into Tools>References and add "Microsoft Outlook 16.0 Object Library"?
Yes, I made sure of that. I changed the code to:
VBA Code:
Dim oApp As Object: Set oApp = CreateObject("Outlook.Application")
Dim oMail As Object: Set oMail = oApp.CreateItem(0)
..and it's working fine. By the way, I like your convention of declaring the variable and setting it on the same line. It makes the code more "readable", in my opinion. Thanks a lot!
 
Upvote 0
Couldn't agree more. I came across that from somebody on here, I'm sure.

Glad you found my error and got it working.
 
Upvote 0
Last question (before the next question... ;)). When the .xlsx file opens, there is an advisory that there are external links. Is it possible to break the links during the export process so the message doesn't appear?
 
Upvote 0
You could copy all sheets to a new book, remove all links in that new book, and then save it as the xlsx version.

VBA Code:
Sub SaveAndMail()

'called from Workbook_BeforeClose() event

'uses a folder titled "Temp" to store the xlsx file
   
    Dim fPath As String: fPath = ThisWorkbook.Path
    Dim tFold As String: tFold = fPath & "\" & "Temp"

'Checks if temp folder exists; if not, it will be created
   
    If FolderExist(tFold) = False Then
        MkDir tFold
    End If

'saves copy to xlsx
   
    Dim nWB As Workbook: Set nWB = Workbooks.Add
    Dim ws As Worksheet, lnk As Variant
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy after:=nWB.Sheets(nWB.Sheets.Count)
    Next ws
    With nWB
        Application.DisplayAlerts = False
        .Sheets(1).Delete
        Application.DisplayAlerts = True
        If Not IsEmpty(.LinkSources(xlExcelLinks)) Then
            For Each lnk In .LinkSources(xlExcelLinks)
                .BreakLink lnk, xlLinkTypeExcelLinks
            Next lnk
        End If
        .SaveAs Filename:=tFold & "\EmailFile.xlsx", FileFormat:=51
        .Close
    End With

'loads email
'**Ensure you have the reference "Microsoft Outlook 16.0 Object Library"
'  added in Tools>References

    Dim oApp As Object: Set oApp = CreateObject("Outlook.Application")
    Dim oMail As Object: Set oMail = oApp.CreateItem(0)

'Fill quotes with your details

    With oMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add tFold & "\" & "EmailFile.xlsx"
        .Display 'or use .Send to send without displaying (subject to Trust Center settings)
    End With

'You can also automatically delete the xlsx file after the email was sent
'BUT... do not use this if you are only displaying the email

    'Kill tFold & "\" & "EmailFile.xlsx"

End Sub

Function FolderExist(folderPath) As Boolean
    FolderExist = Dir(folderPath, vbDirectory) <> ""
End Function
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

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