Automatic E-mail sending

[Hudson]

Hi Forum Experts ,

Can some one advice me with small tweak in the code that helps me sending me email as values ..
to be more precise , i have code that sends email with selected sheets given in the range . below is the code for your reference . everything is working fine until sending mails but the problem aroused at ... selected sheets links getting disabled and we are getting error (#VALUE!)..





Option Explicit

Sub ExportEmail()


Dim objfile As FileSystemObject
Dim xNewFolder
Dim xDir As String, xMonth As String, xFile As String, xPath As String
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim NameX As Name, xStp As Long
Dim xDate As Date, AWBookPath As String
Dim currentWB As Workbook, newWB As Workbook
Dim strEmailTo As String, strEmailCC As String, strEmailBCC As String, strDistroList As String

AWBookPath = ActiveWorkbook.Path & "\"

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = "Creating Email and Attachment for " & Format(Date, "dddd dd mmmm yyyy")

Set currentWB = ActiveWorkbook

xDate = Date

'******************************Grabbing New WorkBook and Formatting*************

Sheets(Array("Brake up", "Summary")).Copy

Set newWB = ActiveWorkbook

Range("A1").Select
Sheets("Brake up").Visible = True
'Sheets ("Email")


'******************************Creating Pathways*********************************

xDir = AWBookPath
xMonth = Format(xDate, "mm mmmm yy") & "\"

xFile = "Daily DA_DB_DZ analysis report " & Format(xDate, "dd-mm-yyyy") & ".xlsx"

xPath = xDir & xMonth & xFile

'******************************Saving File in Pathway*********************************

Set objfile = New FileSystemObject

If objfile.FolderExists(xDir & xMonth) Then
If objfile.FileExists(xPath) Then
objfile.DeleteFile (xPath)
newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

Application.ActiveWorkbook.Close
Else
newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.ActiveWorkbook.Close
End If
Else
xNewFolder = xDir & xMonth
MkDir xNewFolder
newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.ActiveWorkbook.Close
End If

'******************************Preparing Distribution List *********************************


currentWB.Activate
Sheets("Email").Visible = True
Sheets("Email").Select

strEmailTo = ""
strEmailCC = ""
strEmailBCC = ""

xStp = 1

Do Until xStp = 4

Cells(2, xStp).Select

Do Until ActiveCell = ""

strDistroList = ActiveCell.Value

If xStp = 1 Then strEmailTo = strEmailTo & strDistroList & "; "
If xStp = 2 Then strEmailCC = strEmailCC & strDistroList & "; "
If xStp = 3 Then strEmailBCC = strEmailBCC & strDistroList & "; "

ActiveCell.Offset(1, 0).Select

Loop

xStp = xStp + 1

Loop

Range("A1").Select

'******************************Preparing Email*********************************

Set olApp = New Outlook.Application
Dim olNs As Outlook.Namespace
Set olNs = olApp.GetNamespace("MAPI")
olNs.Logon
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = strEmailTo
olMail.CC = strEmailCC
olMail.BCC = strEmailBCC


olMail.Subject = Mid(xFile, 1, Len(xFile) - 4)
olMail.Body = vbCrLf & "Hello Everyone," _
& vbCrLf & vbCrLf & "Please find attached the " & Mid(xFile, 1, Len(xFile) - 4) & "." _
& vbCrLf & vbCrLf & "Regards," _
& vbCrLf & "Genpact"


olMail.Attachments.Add xPath
olMail.Display

Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[gmayor]

I have not tested your code, but your attached worksheet has links to another Workbook. Obviously if you e-mail such a workbook to someone else, they will not have access to that original workbook, which I assume is the reason for the problem that you are encountering. On the face of it you need to break the links and fix the values. This is an Excel issue rather than a Outlook one.

[Hudson]

Gmayor- thank you for your advice ... even I have given a same thought .. Anyway that's great.. I will fix the values before I send an email ..