R
RoadKill
Okay, so I have this script on a worksheet that sends the sheet as an email.
It worked great in '03 but now receives an error message in '07, although the
email does still send okay. I think the problem is deleting the copy after it
is sent. The error message is " Run time Error '70' " - " Permission Denied ".
Here is my code.
Thank you
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim strdate As String
Dim MyArr As Variant
MyArr = Sheets("EmailAddresses").Range("a2:a25")
strdate = Format(Now, "mm-dd-yy")
If Range("D4") = "" Then
MsgBox "Please select Leave Type"
Exit Sub
End If
If Range("D10") = "" Then
MsgBox "Please indicate whether this is a Leave or Return
notification"
Exit Sub
End If
If Range("D10") = "Leave Notification" And Range("D14") = "" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Leave Notification" And Range("D15") = "" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Return Notification" And Range("D21") = "" Then
MsgBox "Please fill out both Return Date fields"
Exit Sub
End If
If Range("D10") = "Return Notification" And Range("D22") = "" Then
MsgBox "Please fill out both Return Date fields"
Exit Sub
End If
If Range("D4") = "STD/CML" And Range("D10") = "Leave Notification" And
Range("D17") = "" Then
MsgBox "Please list Days CAP should subtract from PTO to satisfy
waiting period"
Exit Sub
End If
If Range("D10") = "Update to prior Notification" And Range("D14") =
"" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Update to prior Notification" And Range("D15") = ""
Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail MyArr, "LOA Notice - " & Sheets("STD-LOA").Range("d7")
.ChangeFileAccess xlReadOnly
Kill .FullName
ActiveWorkbook.FollowHyperlink
"\\Dtcdat-azpx001\03667\07800\Forms\Phone Bank Badge Change Application.doc",
" ", NewWindow = True
.Close False
End With
Application.ScreenUpdating = True
End Sub
It worked great in '03 but now receives an error message in '07, although the
email does still send okay. I think the problem is deleting the copy after it
is sent. The error message is " Run time Error '70' " - " Permission Denied ".
Here is my code.
Thank you
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim strdate As String
Dim MyArr As Variant
MyArr = Sheets("EmailAddresses").Range("a2:a25")
strdate = Format(Now, "mm-dd-yy")
If Range("D4") = "" Then
MsgBox "Please select Leave Type"
Exit Sub
End If
If Range("D10") = "" Then
MsgBox "Please indicate whether this is a Leave or Return
notification"
Exit Sub
End If
If Range("D10") = "Leave Notification" And Range("D14") = "" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Leave Notification" And Range("D15") = "" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Return Notification" And Range("D21") = "" Then
MsgBox "Please fill out both Return Date fields"
Exit Sub
End If
If Range("D10") = "Return Notification" And Range("D22") = "" Then
MsgBox "Please fill out both Return Date fields"
Exit Sub
End If
If Range("D4") = "STD/CML" And Range("D10") = "Leave Notification" And
Range("D17") = "" Then
MsgBox "Please list Days CAP should subtract from PTO to satisfy
waiting period"
Exit Sub
End If
If Range("D10") = "Update to prior Notification" And Range("D14") =
"" Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
If Range("D10") = "Update to prior Notification" And Range("D15") = ""
Then
MsgBox "Please fill out both Leave Date fields"
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail MyArr, "LOA Notice - " & Sheets("STD-LOA").Range("d7")
.ChangeFileAccess xlReadOnly
Kill .FullName
ActiveWorkbook.FollowHyperlink
"\\Dtcdat-azpx001\03667\07800\Forms\Phone Bank Badge Change Application.doc",
" ", NewWindow = True
.Close False
End With
Application.ScreenUpdating = True
End Sub