Limit to # of outlook attachments?

ScottyWm

Board Regular
Joined
Jan 10, 2004
Messages
105
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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

ScottyWm

Board Regular
Joined
Jan 10, 2004
Messages
105
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,168,117
Messages
5,857,482
Members
431,882
Latest member
saaaaaaaaaaaaaaaaaaaaaa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top