Hi,
User entered data on Excel Sheet(s) and send to receipant. The returned
sheet(s) should be locked and should not be modfied by the receipant. It
works in Excel 2003. However, it does not work in Excel 2007. User sent the
worksheet(s) but the sheet(s) did not lock as in Excel 2003. Receipants can
modify the sheet(s). I tried many different ways without success.

Please help and thank you for your support.


Private Sub cmdEmail_Click()
Dim cnt As Integer
Dim destWb, srcWb As Workbook
Dim tmpWin, actWin As Window
Dim stWbPath As String
On Error Resume Next

If InStr(1, Sheets("Cluster A").Cells(3, 4), "Validated", vbTextCompare)
Then
Else
MsgBox "Form incomplete. Form did not sent."
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set srcWb = ActiveWorkbook
With srcWb
Set actWin = Active.Window
Set tmpWin = .NewWindow
cnt = Sheets("Cluster A").Cells(5, 2)
If cnt = 1 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets(Array("Cluster A")).Copy
ElseIf cnt = 2 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets(Array("Cluster A", "Cluster B")).Copy
ElseIf cnt = 3 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets("Cluster C").Range("I1:J49").ClearContents
.Sheets("Cluster C").Shapes("Drop down 13").Cut
.Sheets(Array("Cluster A", "Cluster B", "Cluster C")).Copy
End If
End With
tmpWin.Close
Set destWb = ActiveWorkbook
stWbPath = Environ$("temp") & "\"
If appVer < 12 Then
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls"
Else
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls", FileFormat:=56
End If

For ptr = 1 To cnt
destWb.Sheets(cnt).Select
ActiveSheet.Unprotect "$$$ Company1"
ActiveSheet.Cells.Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect Password:="$$$ Company1", DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.Cells(3, 8).Select
Next ptr
destWb.SendMail ", "),
"Company A Form " & Sheets("Cluster A").Cells(3, 8) & " return."
destWb.Close False
MsgBox "Form has been sent to email receipants.", , "Send Form by Email"
Kill stWbPath & "Company A Form " & Sheets("Cluster A").Cells(3, 8) &
".xls"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.Close False
End Sub