Mail every worksheet using A1 as address

sknight22

Board Regular
Joined
Feb 16, 2016
Messages
75
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
 
Stephen

That's strange, for one thing the formatting shouldn't be lost in the first place - when you paste special values the formatting should stay intact.
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hello

Yes when I tested it manually it seemed ok.

I’ll try again tomorrow when I’m at work and see if it was just something I was doing wrong.

Thanks

Stephen.
 
Upvote 0
Hi Norie,

I have just tried this again and it does send the time in an odd format (below)

[TABLE="width: 114"]
<colgroup><col></colgroup><tbody>[TR]
[TD]LOADING TIME[/TD]
[/TR]
[TR]
[TD="align: right"]0.541666667[/TD]
[/TR]
[TR]
[TD="align: right"]0.625[/TD]
[/TR]
[TR]
[TD="align: right"]0.666666667[/TD]
[/TR]
</tbody>[/TABLE]

Any ideas why this could be?

Thanks
Stephen
 
Upvote 0
Stephen

Rather than an odd format, to me that looks like unformatted times.

If I copy that to Excel and format as Time I get this.

LOADING TIME
13:00:00
15:00:00
16:00:00

So somewhere along the line the formatting is being lost, but I can't see anything in the code that would cause that to happen.

Can you post the code as you currently have it?
 
Upvote 0
Hello,

Yes the code I have is

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
 
Upvote 0
Stephen

Can you try this?

Goto the code, select this line,
Code:
Set wb = ActiveWorkbook
add a breakpoint to it using F9 and then run the code.

When code execution stops return to Excel and have a look at the new workbook that's been created.

Is it formatted correctly?
 
Upvote 0
Hello,

Ok, I have done this. When I ran the code it created a new workbook called Book2 with the time formatted correctly

Thanks
Stephen
 
Upvote 0
Stephen

Can you try stepping through the code from that point on with F8 and checking what's actually happening with the new workbook/sheet?
 
Upvote 0
Hi,

Ok i have done that and the format changes from time to the below when i get to
Code:
.Cells.PasteSpecial xlPasteFormats

[TABLE="width: 114"]
<colgroup><col></colgroup><tbody>[TR]
[TD]LOADING TIME[/TD]
[/TR]
[TR]
[TD="align: right"]0.541666667[/TD]
[/TR]
[TR]
[TD="align: right"]0.625[/TD]
[/TR]
[TR]
[TD="align: right"]0.666666667[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Sub RangeA1AddressedSendMail()
Dim OlApp As Object
Dim OutMail As Object
Dim Tempfile As Workbook
Dim TempFileSheeName As String
Dim MailSentFilePath As String
Dim MasterFils As Workbook


Application.DisplayAlerts = False
Application.ScreenUpdating = False


Workbooks.Open Filename:="D:\TestNewFile.xlsx"
Set MasterFils = ActiveWorkbook


For i = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(i).Select
TempFileSheeName = ActiveSheet.Name
If Range("A1").Value <> "" Then
MasterFils.Activate
ActiveSheet.Copy
Set Tempfile = ActiveWorkbook
Application.CutCopyMode = False
ActiveSheet.Name = TempFileSheeName
Tempfile.SaveAs Filename:=ThisWorkbook.Path & "" & TempFileSheeName & ".xlsx"
MailSentFilePath = ActiveWorkbook.FullName
Tempfile.Close

Set OlApp = CreateObject("Outlook.Application")
Set OutMail = OlApp.CreateItem(0)

With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = TempFileSheeName
.Body = "Hi Team," & vbNewLine & "Please find the attached " & TempFileSheeName _
& vbNewLine & vbNewLine & "Regards," & vbNewLine & "SreeMoorthy P"
.Attachments.Add (MailSentFilePath)
.Display
'.Send
End With

End If


Next
MasterFils.Close
MsgBox "File has been mail sent done"


Set Tempfile = Nothing
Set MasterFils = Nothing
Set OlApp = Nothing
Set OutMail = Nothing


End Sub



 
Upvote 0

Forum statistics

Threads
1,223,248
Messages
6,171,011
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top