Consulting

Results 1 to 12 of 12

Thread: Mail every worksheet with address in A1 - not working

  1. #1
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location

    Mail every worksheet with address in A1 - not working

    Hi I am using the code from rondebruin website, for mailing every worksheet with address in A1, but its doing nothing. When I run the macro, I don't get any errors but nothing at all happens. I have outlook 2013 open and I am using excel 2013. Does anyone have any ideas why it won't work?

    Many thank

    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 = "This is the Subject line"
                        .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

  2. #2
    Tested and it works fine.
    Are your macro's enabed?
    Have a nice day,
    Philiep

  3. #3
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    Try changing this bit of code
    without the workbook can not test for faults have you run through the code step by step
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next

  4. #4
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location
    Quote Originally Posted by dotchiejack View Post
    Tested and it works fine.
    Are your macro's enabed?
    Yes macros are enabled, for some reason when I run the macro nothing happens. I don't get any debug error, no mail is created.

  5. #5
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location
    Quote Originally Posted by Rob342 View Post
    Try changing this bit of code
    without the workbook can not test for faults have you run through the code step by step
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
    thanks for reply, I tried this but made no difference. I've run other macros today with no issues so I can't see what the issue is with this one. I have the email address in cell A1 on the sheets, I can't figure it out. Frustrating

  6. #6
    If you change send in the code with display does something happen?
    Have a nice day,
    Philiep

  7. #7
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location
    Quote Originally Posted by dotchiejack View Post
    If you change send in the code with display does something happen?
    I tried that, nothing happens.

  8. #8
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    If the sheets u are coping do not contain macro
    change to the file format to xlsx you don’t need the fileformat no
    make sure outlook is not open when you are activating the command to send
    Last edited by Rob342; 05-23-2019 at 11:55 AM.

  9. #9
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    have done a test on the file
    It looks like its trying to save with a diff format
    change this line & change the temp file as not to include the name of your workbook with the macro
    TempFileName = "Sheet " & sh.Name & " of " _
                             & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") ' it does not like Thisworkbook.Name

  10. #10
    Is the code actually in the workbook you are processing? If not the code will not do anything.
    Change the references from ThisWorkbook to ActiveWorkbook.
    The TempFilePath should be terminated with a backslash folder separator.
    There is no need for the references to old Word version code any longer.
    Use the code from the same website you referenced (see below) to open Outlook correctly. You can then more easily address the body of the message and retain the default signature.
    The following works

    Sub Mail_Every_Worksheet()'Working in Excel 2007-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    'to access the body of the e-mail message use the code from
    'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    'to open Outlook
    'Graham Mayor - https://www.gmayor.com - Last updated - 25 May 2019
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    
    
        TempFilePath = Environ$("temp") & "\"
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set OutApp = OutlookApp()
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Range("A1").value Like "?*@?*.?*" Then
                sh.Copy
                Set wb = ActiveWorkbook
                TempFileName = "Sheet " & sh.Name & " of " _
                               & ActiveWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
                Set OutMail = OutApp.CreateItem(0)
                With wb
                    .SaveAs TempFilePath & TempFileName & ".xlsx", FileFormat:=51
                    With OutMail
                        .BodyFormat = 2    'html
                        .to = sh.Range("A1").value
                        .CC = ""
                        .BCC = ""
                        .Subject = "This is the Subject line"
                        Set olInsp = .GetInspector
                        Set wdDoc = olInsp.WordEditor    'access the message body for editing
                        Set oRng = wdDoc.Range
                        .Display 'This line is required!
                        oRng.Collapse 1
                        oRng.Text = "This is the text of the message" & vbCr & "This is another line of text."
                        .Attachments.Add wb.FullName
                        'You can add other files also like this
                        '.Attachments.Add ("C:\test.txt")
                        '.Send 'Restore after testing
                    End With
                    .Close savechanges:=False
                End With
    
    
                Kill TempFilePath & TempFileName & ".xlsx"
            End If
        Next sh
        Set OutMail = Nothing
        Set OutApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location
    Thank you, this worked brilliantly! Appreciate it
    Quote Originally Posted by gmayor View Post
    Is the code actually in the workbook you are processing? If not the code will not do anything.
    Change the references from ThisWorkbook to ActiveWorkbook.
    The TempFilePath should be terminated with a backslash folder separator.
    There is no need for the references to old Word version code any longer.
    Use the code from the same website you referenced (see below) to open Outlook correctly. You can then more easily address the body of the message and retain the default signature.
    The following works

    Sub Mail_Every_Worksheet()'Working in Excel 2007-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    'to access the body of the e-mail message use the code from
    'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    'to open Outlook
    'Graham Mayor - https://www.gmayor.com - Last updated - 25 May 2019
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    
    
        TempFilePath = Environ$("temp") & "\"
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set OutApp = OutlookApp()
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Range("A1").value Like "?*@?*.?*" Then
                sh.Copy
                Set wb = ActiveWorkbook
                TempFileName = "Sheet " & sh.Name & " of " _
                               & ActiveWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
                Set OutMail = OutApp.CreateItem(0)
                With wb
                    .SaveAs TempFilePath & TempFileName & ".xlsx", FileFormat:=51
                    With OutMail
                        .BodyFormat = 2    'html
                        .to = sh.Range("A1").value
                        .CC = ""
                        .BCC = ""
                        .Subject = "This is the Subject line"
                        Set olInsp = .GetInspector
                        Set wdDoc = olInsp.WordEditor    'access the message body for editing
                        Set oRng = wdDoc.Range
                        .Display 'This line is required!
                        oRng.Collapse 1
                        oRng.Text = "This is the text of the message" & vbCr & "This is another line of text."
                        .Attachments.Add wb.FullName
                        'You can add other files also like this
                        '.Attachments.Add ("C:\test.txt")
                        '.Send 'Restore after testing
                    End With
                    .Close savechanges:=False
                End With
    
    
                Kill TempFilePath & TempFileName & ".xlsx"
            End If
        Next sh
        Set OutMail = Nothing
        Set OutApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub

  12. #12
    VBAX Regular
    Joined
    Feb 2018
    Posts
    41
    Location
    I've a slight problem as I have 150 sheet and there are 12 recipients. I'd like each email address to receive one email with each attachment, rather than 150 different emails going off and people receiving multiple email. Is this possible and what would the coding be? Many thanks

Posting Permissions

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