E-Mailing a File but property set as Read Only

[Sean]

I have the following code (from Ron de Bruin) which e-mails out a sheet
from my master file. I have set this sheet as protected but I wish to
stop the ability of copying the contents of the file to another
workbook. How would I set the temp e-mail file to "Read Only"?. I
thought I saw this feature on Ron de Bruins site at some stage but
can't seem to see it now

Sub Mail_New_Version()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Mail")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheets to values if you want
' For Each sh In Destwb.Worksheets
' sh.Select
' With sh.UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Destwb.Worksheets(1).Select
' Next sh

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now,
"dd-mmm-yy h-mm")

ActiveWindow.TabRatio = 0.908

Sheets("e-mail").Select
ActiveSheet.Protect Password:="1234"

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

For Each cell In ThisWorkbook.Sheets("E-Mail") _
.Columns("BA").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next


With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject = ThisWorkbook.Sheets("Input").Range("BA1").Value
.Body = "Please find attached Daily Salad Detail. Red Boxes
indicate Zero Sales. You should follow up to ensure customers have full
access to all our Menu offerings"
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
.Importance = 1
.DeferredDeliveryTime =
ThisWorkbook.Sheets("E-Mail").Range("BG1").Value
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Ron de Bruin]

Hi Sean

You can use this

.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True

 

[Sean]

Top man Ron, thanks again

I assume I don't now have to password protect the worksheets, as Read
Only effectively does that and more?

 

[Sean]

I must have the wrong understanding of Read Only. I've opened up the
e-mailed file and I could change what I want, specifically I wanted to
disable the users ability to copy the contents of the e-mailed file

 

[Sean]

Searching through the NG's there seems to be not a straight forward
Read Only method.

I spotted this which is placed in ThisWorkbook and activates when you
open the e-mailed file. But how would I create this in what is only a
temp file?

Workbooks.Open Filename:= "C:\TestFile.xls", ReadOnly:=True

 

[Ron de Bruin]

Hi Sean

There is no good way to stop users from copy data out of your workbook.
You can send as PDF maybe

 

[Sean]

Thanks Ron, I've unchecked the "Select Locked Cells" in the sheet and
protected it. So kinda have working what I want, except users can't
receive a passworded file on a Blackberry, there is always a hitch!!

 

[Sean]

Ron, how would you insert code into the ThisWorkbook on the Temp file
via code (while I runmy code to e-mail). I have standard code of
opening each sheet at A1 etc, but unsure of how I could place this code
in a Temp file.

One other thing would be to Password protect VBA project properties in
this Temp file

Thanks
Sean

 

[Ron de Bruin]

Try this

opening each sheet at A1 etc, but unsure of how I could place this code
in a Temp file.

Your example only send one sheet?


1)
If you install my add-in you can send the original workbook with only the sheet you want
Use the Workbook special option then
http://www.rondebruin.nl/mail/add-in.htm

2)
Why not create a workbook with the code in it and copy the sheet you want to
send in that workbook and then send it.

3)
See Chip's page for example to add code to a workbook
http://www.cpearson.com/excel/vbe.htm

 

[Sean]

Thanks Ron, I think I'd prefer to have a blank e-mail file (option 2).
Where by I'd run my code like copying etc from my Master and instead of
creating a temp file, instead e-mail out this "e-mail file" with code
in ThisWorkbook etc

Is it possible to use your/my existing code but slightly tweaked? I've
looked at your site and not sure what I need to do

 

[Ron de Bruin]

Hi Sean

You can use code like this to open your master.xls and copy a sheet to
the file with this macro.
Note in this example C:\master.xls must be closed
You can check if it is open first if you want

Sub test()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Application.ScreenUpdating = False
Set Wb1 = ActiveWorkbook
Set Wb2 = Workbooks.Open("C:\master.xls")
Wb2.Sheets("Sheet1").copy _
after:=Wb1.Sheets(Wb1.Sheets.Count)
Wb2.Close False
Application.ScreenUpdating = True
End Sub

Now WB1 is the file you want to send

 

[Sean]

Thanks Ron, just curious, why couldn't I have the Master Open i.e use
your code in reverse (WB1 closed) I would wish do this as all my code
etc (apart from what I want to place in WB1 ThisWorkbook) is currently
within my Master. In effect WB1 is a dummy

 

[Ron de Bruin]

I am not sure I understand you correct

If you open a file that's already open it will give you a error
You can test if the workbook is open before you try to open it

You can see code like this in this database example
http://www.rondebruin.nl/copy1.htm#workbook

In my example the open file is the file that you will mail, and the code you
want is in that workbook and also the code to open the file master.xls to copy the
sheet you want to send to this workbook.