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