• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

How to send all sheets from the same workbook separately in one email|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / How to send all sheets from the same workbook separately in one email|VBA & Macros|Excel Forum|My Online Training Hub

Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosHow to send all sheets from the sam…
sp_PrintTopic sp_TopicIcon
How to send all sheets from the same workbook separately in one email
Avatar
Dejan C

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 16, 2023
sp_UserOfflineSmall Offline
1
January 16, 2023 - 6:49 am
sp_Permalink sp_Print

I need help to modify this macro to send all sheets from the same workbook separately in one email.

Sub SendemailAll()
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim tempFile As String
Dim strbodymsg As String
Dim wb As Workbook
Dim strbody As String
Dim tempWB As Workbook
Dim DisplayEmail As String, Signature As String
Dim a, b, c, d As String

Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
Set tempWB = ActiveWorkbook

tempWB.SaveAs Filename:="All sheets"
'problem how to separate save all sheets
'variable from userform or string outputs into default documents folder as xls

'Create Outlook email=============
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
End With
Signature = xEmailObj.Body
On Error Resume Next

With xEmailObj
a = ThisWorkbook.Sheets("Sheet1").Range("R1").Value
b = ThisWorkbook.Sheets("Sheet1").Range("R2").Value
c = ThisWorkbook.Sheets("Sheet1").Range("R3").Value
d = ThisWorkbook.Sheets("Sheet1").Range("R4").Value

.Display
.To = a
.CC = b
.Subject = c
.Attachments.Add tempWB.FullName

'previously saved workbook with single sheet
.Body = d & Signature
If DisplayEmail = False Then
'.Display
'.Send
End If
End With

tempWB.ChangeFileAccess Mode:=xlReadOnly
Kill tempWB.FullName
tempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
Set xEmailObj = Nothing
Set xOutlookObj = Nothing
End Sub

Avatar
Velouria
London or thereabouts
Member
Members


Trusted Members
Level 4
Forum Posts: 574
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
2
January 17, 2023 - 2:30 am
sp_Permalink sp_Print

Try something like this:

Sub SendemailAll()
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim tempFile As String
Dim strbodymsg As String
Dim wb As Workbook
Dim strbody As String
Dim tempFiles()
Dim DisplayEmail As String, Signature As String
Dim a, b, c, d As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

ReDim tempFiles(1 To ThisWorkbook.Worksheets.Count)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Copy
With ActiveWorkbook
Dim counter As Long
.SaveAs ThisWorkbook.Path & Application.PathSeparator & ws.Name, FileFormat:=51
counter = counter + 1
tempFiles(counter) = .FullName
.Close savechanges:=False
End With
Next ws

'Create Outlook email=============
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
End With
Signature = xEmailObj.Body
On Error Resume Next

With xEmailObj
a = ThisWorkbook.Sheets("Sheet1").Range("R1").Value
b = ThisWorkbook.Sheets("Sheet1").Range("R2").Value
c = ThisWorkbook.Sheets("Sheet1").Range("R3").Value
d = ThisWorkbook.Sheets("Sheet1").Range("R4").Value

.Display
.to = a
.CC = b
.Subject = c
Dim n As Long
For n = LBound(tempFiles) To UBound(tempFiles)

.Attachments.Add tempFiles(n)
Kill tempFiles(n)
Next n
'previously saved workbook with single sheet
.Body = d & Signature
If DisplayEmail = False Then
'.Display
'.Send
End If
End With

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set xEmailObj = Nothing
Set xOutlookObj = Nothing
End Sub

Avatar
Dejan C

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 16, 2023
sp_UserOfflineSmall Offline
3
January 17, 2023 - 8:50 am
sp_Permalink sp_Print

Thanks for answer, but seams when program copying sheets with ws copy it show error "failed".

Avatar
Velouria
London or thereabouts
Member
Members


Trusted Members
Level 4
Forum Posts: 574
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
4
January 17, 2023 - 6:04 pm
sp_Permalink sp_Print

Are there any hidden sheets in the workbook?

Avatar
Dejan C

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 16, 2023
sp_UserOfflineSmall Offline
5
January 18, 2023 - 2:23 am
sp_Permalink sp_Print

Yes, there were hidden files, I added some in the code.
Thank you very much for your help

Sub Sendemail()
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim tempFile As String
Dim strbodymsg As String
Dim wb As Workbook
Dim strbody As String
Dim tempFiles()
Dim DisplayEmail As String, Signature As String
Dim a, b, c, d As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

ReDim tempFiles(1 To ThisWorkbook.Worksheets.Count)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then

'ws.Select
ws.Copy

With ActiveWorkbook
Dim counter As Long
.SaveAs ThisWorkbook.Path & Application.PathSeparator & ws.Name, FileFormat:=51
counter = counter + 1
tempFiles(counter) = .FullName
.Close SaveChanges:=False
End With
End If
Next ws

Avatar
Velouria
London or thereabouts
Member
Members


Trusted Members
Level 4
Forum Posts: 574
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
6
January 18, 2023 - 2:50 am
sp_Permalink sp_Print

Just to note: cross posted in a couple of places:

https://www.mrexcel.com/board/.....l.1227035/
https://forum.ozgrid.com/forum.....one-email/

The following users say thank you to Velouria for this useful post:

Philip Treacy
sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 170
Currently Online: Alan Sidman, Bouskila stephanie, James Hwang
Guest(s) 64
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1431
Anders Sehlstedt: 848
Velouria: 574
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 213
A.Maurizio: 202
Aye Mu: 201
Jessica Stewart: 185
Newest Members:
David Collins
Andras Marsi
Orimoloye Funsho
YUSUF IMAM KAGARA
PRADEEP PRADHAN
Vicky Otosnika
Abhishek Singh
Kevin Sojourner
Kara Weiss
And Woox
Forum Stats:
Groups: 3
Forums: 24
Topics: 6047
Posts: 26543

 

Member Stats:
Guest Posters: 49
Members: 31497
Moderators: 2
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Riny van Eekelen
© Simple:Press —sp_Information
  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
 
  • About My Online Training Hub
  • Contact
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Copyright © 2023 · My Online Training Hub · All Rights Reserved

Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.

Download A Free Copy of 100 Excel Tips & Tricks

excel tips and tricks ebook

We respect your privacy. We won’t spam you.

x