G
GB
Good morning,
I asked a similar question last week, but have not seen a response. I have
attached my code below. What it does is create a new workbook in memory
using data from a worksheet. I would
1) like to have the workbook name come out as a defined name (all I get now
is like Book1.xls, or Book2.xls as a result of creating the new workbook,
even though I have "code" to name the book.) I would prefer not to have to
save the workbook before sending it, because then I have to figure out how to
pull the file back from the applicable drive location and subsequently delete
it.
2) Like to be able to place the e-mail generated in the users Draft box or
some other mailbox so that they can digitally sign the e-mail. (Or if
someone knows how to programattically sign the e-mail that will allow me to
skip the save step.)
The code "starts in the module called 'Email' for the purpose of this
conversation:
'----------------- Code begins on next line
Option Explicit
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Private Sub CreateFile(IndName As String)
Dim FilePath As String
'Dim NewBook As Workbook
Application.StatusBar = "Opening the Workbook..."
Set NewBook = Workbooks.Add(xlWBATWorksheet)
With NewBook
..Title = IndName
..Subject = IndName
..Sheets(1).Name = IndName
With .Sheets(1).PageSetup
'Work is performed here to format the display of data, page
setup, Margins, Print Range, Print Range setup, headers, and footers.
End With
..Saved = True
End With
Set NewSheet = NewBook.Sheets(1)
NewBook.Activate
Application.StatusBar = False
End Sub
Private Sub EmailIndividual(Individual As IndReportCls)
Dim intI As Integer
Dim IndName As String
Dim Location As Long
Application.ScreenUpdating = False
'Make the file
Call CreateFile(Individual.GetColData(MthRepVars.GetName_Col))
'Create the copy page from those things to be emailed
CopySheet.Cells.Delete 'CopySheet is a worksheet that is hidden from the
user that receives data that can be copied for sending information particular
to the individual.
MonthReport.InsertHeader 'MonthReport is a module, and InsertHeader
inserts the desired header to the active worksheet.
Call Individual.SetEmailed(True) 'Individual is a class object that
supports a boolean variable to track whether the individual has been e-mailed
or not.
For intI = 1 To MonthReport.GetLastColumn
CopySheet.Cells(MonthReport.GetDataStart, intI).Value =
Individual.GetColData(intI) ' This portion of code copies the headers that
should appear in the e-mailed version of the data.
Next intI
Call Individual.SetEmailed(False)
MonthReport.InsertFooter
'Copy the page
CopySheet.Cells.Copy
NewSheet.Cells.PasteSpecial xlPasteAll
'Email them
NewBook.HasRoutingSlip = True
'Ensure the name has no unnecessary periods, so that the mail server can
handle it.
IndName = Individual.GetColData(MthRepVars.GetName_Col)
While InStr(IndName, ".") > 0
Location = InStr(IndName, ".")
If Location = 1 Then
IndName = Right(IndName, Len(IndName) - Location)
ElseIf Location = Len(IndName) Then
IndName = Left(IndName, Location - 1)
Else
IndName = Left(IndName, Location - 1) + Right(IndName,
Len(IndName) - Location)
End If
Wend
On Error GoTo ErrorMailing
With NewBook.RoutingSlip
..Delivery = xlAllAtOnce
..Recipients = IndName
'.Recipients = Array(IndName)
..ReturnWhenDone = False
..Subject = "[Subject Text Desired]"
..Message = "[Message that explains what this e-mail is about]"
End With
NewBook.Route
Call Individual.SetEmailed(True)
ErrorMailing:
NewBook.HasRoutingSlip = False
Err.Clear
On Error GoTo 0
NewBook.Saved = True
NewBook.Close
Application.ScreenUpdating = True
End Sub
'-----------------------------------Code is complete for purpose of this
conversation.
I asked a similar question last week, but have not seen a response. I have
attached my code below. What it does is create a new workbook in memory
using data from a worksheet. I would
1) like to have the workbook name come out as a defined name (all I get now
is like Book1.xls, or Book2.xls as a result of creating the new workbook,
even though I have "code" to name the book.) I would prefer not to have to
save the workbook before sending it, because then I have to figure out how to
pull the file back from the applicable drive location and subsequently delete
it.
2) Like to be able to place the e-mail generated in the users Draft box or
some other mailbox so that they can digitally sign the e-mail. (Or if
someone knows how to programattically sign the e-mail that will allow me to
skip the save step.)
The code "starts in the module called 'Email' for the purpose of this
conversation:
'----------------- Code begins on next line
Option Explicit
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Private Sub CreateFile(IndName As String)
Dim FilePath As String
'Dim NewBook As Workbook
Application.StatusBar = "Opening the Workbook..."
Set NewBook = Workbooks.Add(xlWBATWorksheet)
With NewBook
..Title = IndName
..Subject = IndName
..Sheets(1).Name = IndName
With .Sheets(1).PageSetup
'Work is performed here to format the display of data, page
setup, Margins, Print Range, Print Range setup, headers, and footers.
End With
..Saved = True
End With
Set NewSheet = NewBook.Sheets(1)
NewBook.Activate
Application.StatusBar = False
End Sub
Private Sub EmailIndividual(Individual As IndReportCls)
Dim intI As Integer
Dim IndName As String
Dim Location As Long
Application.ScreenUpdating = False
'Make the file
Call CreateFile(Individual.GetColData(MthRepVars.GetName_Col))
'Create the copy page from those things to be emailed
CopySheet.Cells.Delete 'CopySheet is a worksheet that is hidden from the
user that receives data that can be copied for sending information particular
to the individual.
MonthReport.InsertHeader 'MonthReport is a module, and InsertHeader
inserts the desired header to the active worksheet.
Call Individual.SetEmailed(True) 'Individual is a class object that
supports a boolean variable to track whether the individual has been e-mailed
or not.
For intI = 1 To MonthReport.GetLastColumn
CopySheet.Cells(MonthReport.GetDataStart, intI).Value =
Individual.GetColData(intI) ' This portion of code copies the headers that
should appear in the e-mailed version of the data.
Next intI
Call Individual.SetEmailed(False)
MonthReport.InsertFooter
'Copy the page
CopySheet.Cells.Copy
NewSheet.Cells.PasteSpecial xlPasteAll
'Email them
NewBook.HasRoutingSlip = True
'Ensure the name has no unnecessary periods, so that the mail server can
handle it.
IndName = Individual.GetColData(MthRepVars.GetName_Col)
While InStr(IndName, ".") > 0
Location = InStr(IndName, ".")
If Location = 1 Then
IndName = Right(IndName, Len(IndName) - Location)
ElseIf Location = Len(IndName) Then
IndName = Left(IndName, Location - 1)
Else
IndName = Left(IndName, Location - 1) + Right(IndName,
Len(IndName) - Location)
End If
Wend
On Error GoTo ErrorMailing
With NewBook.RoutingSlip
..Delivery = xlAllAtOnce
..Recipients = IndName
'.Recipients = Array(IndName)
..ReturnWhenDone = False
..Subject = "[Subject Text Desired]"
..Message = "[Message that explains what this e-mail is about]"
End With
NewBook.Route
Call Individual.SetEmailed(True)
ErrorMailing:
NewBook.HasRoutingSlip = False
Err.Clear
On Error GoTo 0
NewBook.Saved = True
NewBook.Close
Application.ScreenUpdating = True
End Sub
'-----------------------------------Code is complete for purpose of this
conversation.