Results 1 to 6 of 6

Thread: Macro to attach several sheets to email

  1. #1
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,334
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Macro to attach several sheets to email

    I have the following macro to email a specific sheet


    I need to amend this to add sheet 'dashboard' to be attached to email
    Code:
     
    'Copy the ActiveSheet to a new workbook
        Sheets("overaged").Copy
        Set Destwb = ActiveWorkbook


    Code:
     Sub Email_Overaged_Stock_Report()
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .CutCopyMode = False
    End With
    
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim OutApp As Object
        Dim OutMail As Object
        Dim Strinbody As String
        
       
    
        Set Sourcewb = ActiveWorkbook
    
    
       
    
        'Copy the ActiveSheet to a new workbook
        Sheets("overaged").Copy
        Set Destwb = ActiveWorkbook
    
        'Determine the Excel version and file extension/format
        With Destwb
            If Val(Application.Version) < 12 Then
                'You use Excel 97-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007-2013
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End With
    
        'Change all cells in the worksheet to values if you want
            With Destwb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False
    
        'Save the new workbook/Mail it/Delete it
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "" & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        With Destwb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "Overaged & Dashboard reports"
                strBody = "Hi Guys" & vbNewLine & vbNewLine
                strBody = strBody & "Attached Please find Dashboard & Summary Report"s & vbNewLine & vbNewLine
                strBody = strBody & "Regards" & vbNewLine & vbNewLine
               strBody = strBody & ""
    
                .Body = strBody
                .Attachments.Add Destwb.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display   'Use .send to send automatically or  .Display to check email before sending
            End With
            On Error GoTo 0
            .Close savechanges:=False
        End With
    
        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
       With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .CutCopyMode = False
    End With
    
    End Sub

    It would be appreciated if someone could amend my code so that Sheet "Dashboard" will also be attached to my email

  2. #2
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,334
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to attach several sheets to email

    Managed to sort this out by amending

    Code:
     Sheets("overaged").Copy
     to Sheets(array(("Dashboard", "overaged")).Copy

  3. #3
    Board Regular sykes's Avatar
    Join Date
    May 2002
    Location
    Cornwall,England
    Posts
    1,560
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to attach several sheets to email

    Untested, but this should work:
    Code:
        Sheets(Array("overaged", "dashboard")).Copy
        Set Destwb = ActiveWorkbook
    Sykes
    Windows 10 / XL 2016
    Members don't have crystal balls, so PLEASE describe your situation, code,
    and requirements ACCURATELY in your first post. It saves hair!
    Better still - upload your spreadsheet (and formulae!) with this great bit of kit.


    - forum use guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

  4. #4
    Board Regular sykes's Avatar
    Join Date
    May 2002
    Location
    Cornwall,England
    Posts
    1,560
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to attach several sheets to email

    Beat me to it! Posts crossed, i think.
    Sykes
    Windows 10 / XL 2016
    Members don't have crystal balls, so PLEASE describe your situation, code,
    and requirements ACCURATELY in your first post. It saves hair!
    Better still - upload your spreadsheet (and formulae!) with this great bit of kit.


    - forum use guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

  5. #5
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,334
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to attach several sheets to email

    Thanks for your Input.

  6. #6
    Board Regular sykes's Avatar
    Join Date
    May 2002
    Location
    Cornwall,England
    Posts
    1,560
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to attach several sheets to email

    Pleasure.
    Sykes
    Windows 10 / XL 2016
    Members don't have crystal balls, so PLEASE describe your situation, code,
    and requirements ACCURATELY in your first post. It saves hair!
    Better still - upload your spreadsheet (and formulae!) with this great bit of kit.


    - forum use guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •