Excel crashes when saving - emailing

[shawnhet]

Hi folks,

I have a macro that creates a copy of a couple of pages of a main sheet and emails them. This generally works fine, but ~5% Excel will crash giving me the following message:

Microsoft Excel is waiting for another application to complete and OLE action.

This freezes the computer and I am hoping that one of the resident geniuses here will have some idea what is causing this and how to prevent it. (As I said, it works fine most of the time).

Thanks in advance.

Cheers,

[VBA]
Dim FileName As String
FileName = "S:\Myfiles" & Range("E7").Value & " " & Format(Now, "dd-mmm-yy") & ".xls"
ActiveWorkbook.SaveAs FileName:="S:\Myfiles" & Range("E7").Value & " " & Format(Now, "dd-mmm-yy"), FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWindow.SmallScroll Down:=9

ThisWorkbook.Sheets("Formdetails").Range("A1:K100").Copy
ActiveWorkbook.Sheets("Sheet2").Select

Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Sheets("Sheet1").Select
ActiveWorkbook.Save


Dim OutApp As Object
Dim OutMail As Object

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

On Error Resume Next
With OutMail
.To = "who@cares.com;"
.CC = ""
.BCC = ""
.Subject = Range("E7").Value






.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Windows("Mainfile.xls").Activate
Sheets("Sheet1").Select[/VBA]

[shawnhet]

BTW, I am using Excel 2003.