Limit to # of outlook attachments?

[ScottyWm]

I am using the following code to generate Outlook emails to multiple recipients with each recipient getting a separate worksheet tab from the file. It works great for the first 30 emails, then gives an error saying I don't have permission to write to the folder. Is there a limit to how many outlook emails can have attachments or something? I haven't had this problem before (have run this many times), so I rebooted and checked my freespace and memory and all - don't see any problem.

Any help??

Sub SendEmail()
Dim MailRange As Range
Set MailRange = Worksheets("Data Entry").Range("d7:u800")
' this works to send email to each supplier
' 1) worksheet tabs have to exactly match names on Data entry page
' 2) Supplier worksheets must have their name in cell A1

Dim OutApp As Object
Dim OutMail As Object
Dim Dist As String

ActiveWorkbook.Protect Structure:=False, Windows:=False

Dim ws As Worksheet

Sheets("Data Entry").Select

For Each ws In Worksheets
If (ws.Cells(1, 1) <> "") Then
Dist = Application.WorksheetFunction.VLookup(ws.Name, MailRange, 18)
Sbject = Application.WorksheetFunction.VLookup(ws.Name, MailRange, 1)

ws.Copy
Application.DisplayAlerts = False
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ActiveWorkbook.SaveAs Filename:= _
"h:\shared\scott m\PPM Report.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = Dist
' COPY TO WHOM?
.CC = ""
.BCC = ""
.Subject = Sbject & " - Monthly Supplier PPM Report"
.Body = "Attached you will find the quality tracking report for the previous month." & _
" blah, blah blah..."

'THIS IS WHERE THE MACRO HALTS. IF I PUT IN the On error Resume Next statement, EVERYTHING RUNS BUT IT FAILS TO ADD THE ATTACHMENTS. IT DOES HOWEVER STILL SAVE THE EXCEL FILE PPM Report.xls (no permission problem).

.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Windows("PPM Report.xls").Activate
ActiveWorkbook.Close

End If
Next ws

End Sub

 

[ScottyWm]

Okay, it was repeatedly doing 30 before messing up. Now it is only doing 12 each time I run it. I've cleaned out my Outlook mailbox just to be sure it wasn't a space problem - no help.