![]() |
E-Mailing a File but property set as Read Only
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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
Hi Sean
You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
Hi Sean
There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
E-Mailing a File but property set as Read Only
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. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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 Sean wrote: 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!! Ron de Bruin wrote: Hi Sean There is no good way to stop users from copy data out of your workbook. You can send as PDF maybe -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message oups.com... 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 Sean wrote: 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 wrote: 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? Ron de Bruin wrote: Hi Sean You can use this .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, ReadOnlyRecommended:=True -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sean" wrote in message ups.com... 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(xlCellTypeConsta nts) 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 |
All times are GMT +1. The time now is 11:58 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com