G
Guest
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(xlCellTypeConstants)
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!
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(xlCellTypeConstants)
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!