Good morning,

I have asked a similar question to the excel.programming group, but have yet
to see a response. I have code attached below. What it does is create a new
workbook in memory using data from a worksheet. I have the following two
basic questions/requests. Answer whatever you can, I'll sort it out in the
end.

1) From Excel I would 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.) However, I am unfamiliar/unsure if I can do this from
within excel based on some of the suggestions I have reviewed in this
discussion area.
2) I would 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. Of course this being the outlook group, I don't necessarily expect this
question to be answered here, but if someone can assist, I would appreciate
it.

The code "starts" in the module called 'EmailIndividual' 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.

Archived from group: microsoft>public>office>developer>outlook>vba