BCBSSC_Jon
New Member
I borrowed the code described here...
http://chandoo.org/wp/2012/04/23/send-mails-using-excel-vba-and-outlook/
What I need is a method to attach macros, to the "Generated Excel" sheet.
or a way to add the Name.xlam to the add-ins of the "Generated Excel" sheet.
Below is the code that generates the Email, and the new workbook.
Thanks Jon
http://chandoo.org/wp/2012/04/23/send-mails-using-excel-vba-and-outlook/
What I need is a method to attach macros, to the "Generated Excel" sheet.
or a way to add the Name.xlam to the add-ins of the "Generated Excel" sheet.
Below is the code that generates the Email, and the new workbook.
Code:
Option Explicit
Sub Export_LSA_MAIL()
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("Email", "NGD-Cover", "NGD-data", "NGD-Form")).Copy
Set newWB = ActiveWorkbook
'Sheets("NGD-FORM").Visible = True
'Sheets("NGD-FORM").Select
Range("A1").Select
Sheets("NGD-Data").Visible = True
Sheets("NGD-Cover").Visible = True
Sheets("Email").Visible = True
Sheets("NGD-FORM").Select
'******************************Creating Pathways*********************************
xDir = AWBookPath
xMonth = Format(xDate, "mm mmmm yy") & "\"
xFile = "CCTG - NGD Form " & Format(xDate, "mm-dd-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 & "CCTG.STAFF"
olMail.Attachments.Add xPath
olMail.Display
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = False
' If you want to attach the workbook that contains the code, you need to make the file read-only when you send it and then change access back to read-write. For example,
' ThisWorkbook.Save
' ThisWorkbook.ChangeFileAccess xlReadOnly
' B = SendEmail( _
' ... parameters ...
' Attachments:=ThisWorkbook.FullName)
' ThisWorkbook.ChangeFileAccess xlReadWrite
End Sub
Thanks Jon
Last edited by a moderator: