• 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
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • 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

vba course banner

Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
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
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 648
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
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 648
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
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 648
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: 245
Currently Online: David Jernigan, Louis Muti
Guest(s) 9
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 873
Purfleet: 414
Frans Visser: 346
David_Ng: 306
lea cohen: 222
Jessica Stewart: 218
A.Maurizio: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
Charles DeGraffenreaid
Cathi Giard
Sarah Young
Henry Delgado
Alita Nieuwoudt
KL KOH
Joao Marques
Regi Hampton
Taffie Elliott
Paramita Chakraborty
Forum Stats:
Groups: 3
Forums: 24
Topics: 6359
Posts: 27806

 

Member Stats:
Guest Posters: 49
Members: 32336
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • 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
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

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.