Hi
This code copies sheet1 and emails it. How can I mail values only without
links?

strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Myfile" & Range("B56") & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail

For Each Cell In ThisWorkbook.Sheets("Distribution List") _
.Columns("B").Cells.SpecialCells(xlCellTypeConstan ts)
If Cell.Value Like "*@*" Then
strto = strto & Cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

.To = strto
.CC = ""
.BCC = ""
.Subject = "Loadfcst" & Range("B56") & ".xls"
.Body = ""
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

Application.ScreenUpdating = True
End With

Thanks!

Hi Saeed

See
http://www.rondebruin.nl/mail/tips2.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Saeed" wrote in message ...
Hi
This code copies sheet1 and emails it. How can I mail values only without
links?

strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Myfile" & Range("B56") & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail

For Each Cell In ThisWorkbook.Sheets("Distribution List") _
.Columns("B").Cells.SpecialCells(xlCellTypeConstan ts)
If Cell.Value Like "*@*" Then
strto = strto & Cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

.To = strto
.CC = ""
.BCC = ""
.Subject = "Loadfcst" & Range("B56") & ".xls"
.Body = ""
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

Application.ScreenUpdating = True
End With

Thanks!

Is there any reason you can't do a Copy-Paste Special-Values before setting
ScreenUpdating = False?



"Saeed" wrote:

Hi
This code copies sheet1 and emails it. How can I mail values only without
links?

strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Myfile" & Range("B56") & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail

For Each Cell In ThisWorkbook.Sheets("Distribution List") _
.Columns("B").Cells.SpecialCells(xlCellTypeConstan ts)
If Cell.Value Like "*@*" Then
strto = strto & Cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

.To = strto
.CC = ""
.BCC = ""
.Subject = "Loadfcst" & Range("B56") & ".xls"
.Body = ""
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

Application.ScreenUpdating = True
End With

Thanks!

Thank you!

"Ron de Bruin" wrote:

Hi Saeed

See
http://www.rondebruin.nl/mail/tips2.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Saeed" wrote in message ...
Hi
This code copies sheet1 and emails it. How can I mail values only without
links?

strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Myfile" & Range("B56") & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail

For Each Cell In ThisWorkbook.Sheets("Distribution List") _
.Columns("B").Cells.SpecialCells(xlCellTypeConstan ts)
If Cell.Value Like "*@*" Then
strto = strto & Cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

.To = strto
.CC = ""
.BCC = ""
.Subject = "Loadfcst" & Range("B56") & ".xls"
.Body = ""
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

Application.ScreenUpdating = True
End With

Thanks!