Upcoming Power Excel Seminars
Page 1 of 3 123 LastLast
Results 1 to 10 of 28

Thread: Mail every worksheet using A1 as address

  1. #1
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Mail every worksheet using A1 as address

    Hello
    I am using code from the below link to send multiple sheets to email addresses in cell a1.

    http://www.rondebruin.nl/win/s1/outlook/amail5.htm

    I have hit a snag though. My sheets are made up of filtered pivots and I donít want the recipient to be able to take the filter off.

    Could the code be amended to first copy and paste special the whole sheet then send?

    Thanks

    Stephen

  2. #2
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    73,540
    Post Thanks / Like
    Mentioned
    22 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Stephen

    Where on the sheets are the pivots located?

    Are there multiple pivots on each sheet?
    If posting code please use code tags.

  3. #3
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Hi Norie

    I basically have a sheet with my raw data. Then a master pivot which I have copied to several sheets in the workbook and filtered by company.

    It is just one pivot per sheet

    I have the code that will send each sheet to the address in cell a1 in each sheet but I donít want the person receiving to be able to remove filters and view other company info, so just wondered if it can be adapted to copy and paste special first?

    Or something similar

    Thank you for reading
    Last edited by sknight22; May 15th, 2018 at 05:13 AM.

  4. #4
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    I have another workbook that does a similar thing - it takes the pivot in each sheet and saves it as a single workbook in a new folder.

    This sheet does copy and paste special before it saves using the below code. I am just not sure where to put it in my other code though?

    Any ideas?

    'Change all cells in the worksheet to values
    If Destwb.Sheets(1).ProtectContents = False Then
    With Destwb.Sheets(1).UsedRange
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
    .Cells(1).Select
    End With
    Application.CutCopyMode = False
    End If

  5. #5
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    73,540
    Post Thanks / Like
    Mentioned
    22 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Stephen

    Can you post your current code?
    If posting code please use code tags.

  6. #6
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Quote Originally Posted by Norie View Post
    Stephen

    Can you post your current code?
    Hi Yes it is;

    Sub Mail_Every_Worksheet()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object


    TempFilePath = Environ$("temp") & ""


    If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    'You use Excel 2007-2016
    FileExtStr = ".xlsm": FileFormatNum = 52
    End If


    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With


    Set OutApp = CreateObject("Outlook.Application")


    For Each sh In ThisWorkbook.Worksheets
    If sh.Range("A1").Value Like "?*@?*.?*" Then


    sh.Copy
    Set wb = ActiveWorkbook


    TempFileName = "Sheet " & sh.Name & " of " _
    & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


    Set OutMail = OutApp.CreateItem(0)


    With wb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum


    On Error Resume Next
    With OutMail
    .to = sh.Range("A1").Value
    .CC = ""
    .BCC = ""
    .Subject = "TEST"
    .Body = "Hi there"
    .Attachments.Add wb.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .Send 'or use .Display
    End With
    On Error GoTo 0


    .Close savechanges:=False
    End With

    Set OutMail = Nothing


    Kill TempFilePath & TempFileName & FileExtStr


    End If
    Next sh


    Set OutApp = Nothing


    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub

  7. #7
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    73,540
    Post Thanks / Like
    Mentioned
    22 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Stephen

    This should incorporate the code to copy and paste special values but it's untested right now.

    Code:
    Option Explicit
    
    Sub Mail_Every_Worksheet()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
            
        TempFilePath = Environ$("temp") & ""
            
        If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
        'You use Excel 2007-2016
            FileExtStr = ".xlsm": FileFormatNum = 52
        End If
               
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
            
        Set OutApp = CreateObject("Outlook.Application")
        
        For Each sh In ThisWorkbook.Worksheets
        
            If sh.Range("A1").Value Like "?*@?*.?*" Then
                            
                sh.Copy
                
                Set wb = ActiveWorkbook
                
                'Change all cells in the worksheet to values
                
                With wb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells(1).Select
                End With
                
                Application.CutCopyMode = False
                
                TempFileName = "Sheet " & sh.Name & " of " _
                & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
                            
                Set OutMail = OutApp.CreateItem(0)
                            
                With wb
                    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
                    
                    On Error Resume Next
                        With OutMail
                        .to = sh.Range("A1").Value
                        .CC = ""
                        .BCC = ""
                        .Subject = "TEST"
                        .Body = "Hi there"
                        .Attachments.Add wb.FullName
                        'You can add other files also like this
                        '.Attachments.Add ("C:\test.txt")
                        .Send 'or use .Display
                    End With
                    On Error GoTo 0
                    
                    .Close savechanges:=False
                End With
                
                Set OutMail = Nothing
                
                Kill TempFilePath & TempFileName & FileExtStr
            
            End If
            
        Next sh
            
        Set OutApp = Nothing
            
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
    End Sub
    If posting code please use code tags.

  8. #8
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Hello again
    "
    Thanks this is amazing. I have just tested and it is great. Theres just one thing. I mistakenly thought i needed it to "paste special values" but some of the data is formatted as time so doesn't look right.

    Is it possible for it to "Paste special values and source formatting"?

    Sorry to be a pain - this is the closest ive ever been to it working 100%

    Thank you again for all your help with this

    Stephen

  9. #9
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    73,540
    Post Thanks / Like
    Mentioned
    22 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Stephen

    Off the top of my head, and again untested.
    Code:
    Option Explicit
    
    Sub Mail_Every_Worksheet()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
            
        TempFilePath = Environ$("temp") & ""
            
        If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
        'You use Excel 2007-2016
            FileExtStr = ".xlsm": FileFormatNum = 52
        End If
               
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
            
        Set OutApp = CreateObject("Outlook.Application")
        
        For Each sh In ThisWorkbook.Worksheets
        
            If sh.Range("A1").Value Like "?*@?*.?*" Then
                            
                sh.Copy
                
                Set wb = ActiveWorkbook
                
                'Change all cells in the worksheet to values
                
                With wb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells.PasteSpecial xlPasteFormats
                End With
                
                Application.CutCopyMode = False
                
                TempFileName = "Sheet " & sh.Name & " of " _
                & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
                            
                Set OutMail = OutApp.CreateItem(0)
                            
                With wb
                    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
                    
                    On Error Resume Next
                        With OutMail
                        .to = sh.Range("A1").Value
                        .CC = ""
                        .BCC = ""
                        .Subject = "TEST"
                        .Body = "Hi there"
                        .Attachments.Add wb.FullName
                        'You can add other files also like this
                        '.Attachments.Add ("C:\test.txt")
                        .Send 'or use .Display
                    End With
                    On Error GoTo 0
                    
                    .Close savechanges:=False
                End With
                
                Set OutMail = Nothing
                
                Kill TempFilePath & TempFileName & FileExtStr
            
            End If
            
        Next sh
            
        Set OutApp = Nothing
            
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
    End Sub
    If posting code please use code tags.

  10. #10
    Board Regular
    Join Date
    Feb 2016
    Posts
    58
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Mail every worksheet using A1 as address

    Hi Norie

    Its so close. when i run this code the loading times in the sheet (formatted as time, below in black) are copied over and pasted as the below (in red)
    LOADING TIME
    13:00:00
    15:00:00
    16:00:00

    LOADING TIME
    0.541666667
    0.625
    0.666666667

    Any ideas on a fix for this?

    Thanks for your time with this


    Stephen

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
  •  

 

DMCA.com