The macro below works great in excel 2003. however in excel 2007 I get
a mesage as follows:-

The following features cannot be saved in macro free workbook

VBProject

To save a file with these features click no, then choose a macro
enabled file type in the File Type list.

To continue saving as a macro free workbook chose yes.


The code below I put together several years ago with the help of a Ron
DeBriun posting.

The workbook itself is an excel 97-2003 format (in excel 2007 it comes
up as (combatability mode), I'm the only user currently using excel
2007, other users will remain on excel 2003 until this problem is
resolved. The problem occur when I save the file to email, I noted the
location below where the macro fails

..SaveAs " " & sh.Name & " " & custname & " " & strdate & ".xls" this
line fails.

Any help would be greatly appreciated

burl_rfc

Sub Rectangle15_Click()
'Mail_Every_Worksheet2()
Dim sh As Worksheet
Dim wb As Workbook
Dim strdate As String
Dim custname As String
Dim MyArrIndex As Long
Dim E_Mail_Count As Long
Dim cell As Range
Dim MyArr() As String
Application.ScreenUpdating = False
Worksheets("QuoteForm").Activate
Range("I10").Select
Selection.Copy
Range("L2").Select
custname = Range("b7")
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("L1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "mm-dd-yy h-mm-ss")

E_Mail_Count = sh.Columns("L").Cells.SpecialCells
(xlCellTypeConstants).Count
ReDim MyArr(1 To E_Mail_Count)
MyArrIndex = 1
For Each cell In sh.Columns("L").Cells.SpecialCells
(xlCellTypeConstants)
If cell Like "*@*" Then
MyArr(MyArrIndex) = cell.Value
MyArrIndex = MyArrIndex + 1
End If
Next
ReDim Preserve MyArr(1 To MyArrIndex)

sh.Copy
Set wb = ActiveWorkbook
sh.Name = Range("b6")
With wb

problem ocurrs on the following line

.SaveAs " " & sh.Name & " " & custname & " " &
strdate & ".xls"

.SendMail MyArr, _
"New DT Flycut Quote (Customer: " & custname
& ") "
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With

End If

Next sh

Application.ScreenUpdating = True
ActiveSheet.Name = "QuoteForm"
Worksheets("Quote Data Entry").Activate

Call Rectangle16_Click

End Sub