E
EM.Bateman
Using Office 2003 on an XP Professional platform.
I have a workbook that contains several worksheets. I've found code
that will allow the end user to click a button and send only the
current worksheet to whomever s/he wants. However, on one sheet I need
to be able to set it up to be routed. The addresses reside in a Named
Range called "Routing" because the routing may change depending on the
group the requestor belongs to.
I don't know jack about VBA programming (although I've done some C++).
This is what I've managed to cobble together so far:
Sub mcr_MailActiveSheet()
Dim strDate As String
ActiveSheet.Copy
strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
ActiveWorkbook.SaveAs ActiveSheet.Name _
& ".xls"
ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array(Routing)
.ReturnWhenDone = True
.TrackStatus = True
End With
ActiveWorkbook.ChangeFileAccess xlReadOnly
ActiveWorkbook.SendMail "", ActiveWorkbook.Name
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
End Sub
The first problem I'm having is that the recipient name is not showing
up when I click the submit button. It brings up a new email but the
"To:" line is empty. I do get multiple security messages ("A program
is trying to access . . ."), though.
The second problem is that I'm having some difficulty with the IF
statement so that the routing portion of the code happens only if
ActiveWorkbook.Name = "Leave_Request.xls"
Any help would be greatly appreciated.
I have a workbook that contains several worksheets. I've found code
that will allow the end user to click a button and send only the
current worksheet to whomever s/he wants. However, on one sheet I need
to be able to set it up to be routed. The addresses reside in a Named
Range called "Routing" because the routing may change depending on the
group the requestor belongs to.
I don't know jack about VBA programming (although I've done some C++).
This is what I've managed to cobble together so far:
Sub mcr_MailActiveSheet()
Dim strDate As String
ActiveSheet.Copy
strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
ActiveWorkbook.SaveAs ActiveSheet.Name _
& ".xls"
ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array(Routing)
.ReturnWhenDone = True
.TrackStatus = True
End With
ActiveWorkbook.ChangeFileAccess xlReadOnly
ActiveWorkbook.SendMail "", ActiveWorkbook.Name
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
End Sub
The first problem I'm having is that the recipient name is not showing
up when I click the submit button. It brings up a new email but the
"To:" line is empty. I do get multiple security messages ("A program
is trying to access . . ."), though.
The second problem is that I'm having some difficulty with the IF
statement so that the routing portion of the code happens only if
ActiveWorkbook.Name = "Leave_Request.xls"
Any help would be greatly appreciated.