Password Protecting an Attachment sent via VBA

[John]

I have the following code (kindly by Ron de Bruin) which extracts an excel
attactment for e-mail. My problem is that I wish to password protect all
sheets in the attachment and not sure how to do i. I do notice a statement
within the code of " .ChangeFileAccess xlReadOnly" which I would have
thought would have made the attachment read-only, but thats not the case.

Any help I would be grateful



Sub Mail_Reports()
Dim wb As Workbook
Dim strdate As String
Dim MyArr As Variant
On Error Resume Next
strdate = Format(Now, "dd-mm-yy h-mm")
Application.ScreenUpdating = False
Sheets("E-Schedule").Visible = True
Sheets("E-Sales Hours").Visible = True
Sheets("E-Import").Visible = True
Sheets(Array("E-Schedule", "E-Sales Hours", "E-Import")).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Name _
& " Sent on" & " " & strdate & ".xls"
MyArr = Sheets("E-Schedule").Range("AG1:AG3")
.SendMail MyArr, Sheets("E-Schedule").Range("AG4").Value
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Sheets(Array("E-Schedule")).Select
ActiveWindow.SelectedSheets.Visible = False
Sheets(Array("E-Sales Hours")).Select
ActiveWindow.SelectedSheets.Visible = False
Sheets(Array("E-Import")).Select
ActiveWindow.SelectedSheets.Visible = False

Sheets("Home").Select
Range("A1").Select
On Error GoTo 0
End Sub

 

[Casey]

John,

Try something like:

Dim AnySheet As Worksheet

For Each AnySheet In ActiveWorkbook.Worksheets
ActiveWorkbook.Worksheets(AnySheet.Name) _
.Protect Password:="mypassword"
Next


HT

 

[John]

Thanks Casey

Unfortunately its still unprotected