Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Mass emailing with attachments 2010

Status
Not open for further replies.

Dom606

IS-IT--Management
Jul 29, 2007
123
0
16
US
I have used the code below in Access 2000, 2003, 2007 and now 2010. I am also using Access 2010 with Windows 8.1.
The problem is this code worked well until I went to Windows 8.1. It should send email to 300 recipients with 3 attachments. However, it sends about 150 and then a message pops up saying you do not have permission to write to the file you saving to.

I have no idea what this means since it successfully sent 150 emails with attachments.
Any ideas as to how to improve the code or fix the problem?
Thanks



Code:
Option Compare Database
Option Explicit
' You need to declare a reference to the Outlook library, and the filesystemobject.
' this is not as hard as it sounds.
'
' Look in the menu above, and click Tools, then select References
'
' Scroll down the list until you see
' Microsoft Scripting Runtime -- and put a check next to it (if one is not there already)
'

Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyNewBodyText As String
Dim MyBodyText As String

Set fso = New FileSystemObject

   ' First, we need to know the subject.
Subjectline$ = InputBox$("Please enter the subject line for this mailing.", _
"We Need A Subject Line!")
   ' If there's no subject, call it a day.

If Subjectline$ = "" Then
    MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
        "Quitting...", vbCritical, "E-Mail Merger"
    Exit Function
End If
   
    
   ' Now we need to put something in our letter...
    BodyFile$ = "C:\Users\Dominic\Documents\FALCON\Newsletter Stuff\body.txt"
   

   ' If there's nothing to say, call it a day.
If BodyFile$ = "" Then
    MsgBox "No body, no message." & vbNewLine & vbNewLine & _
         "Quitting...", vbCritical, "I Ain't Got No-Body!"
    Exit Function
End If
   ' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
    MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & _
           "Quitting...", vbCritical, "I Ain't Got No-Body!"
    Exit Function
End If

   ' Since we got a file, we can open it up.
    Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)

   ' and read it into a variable.
    MyBodyText = MyBody.ReadAll

   ' and close the file.
    MyBody.Close

   ' Now, we open Outlook for our own device..
    Set MyOutlook = New Outlook.Application

   ' Set up the database and query connections
    Set db = CurrentDb()
 
    Set MailList = db.OpenRecordset("qryMasterQuery_WithEmail")

   ' now, this is the meat and potatoes.
   ' this is where we loop through our list of addresses,
   ' adding them to e-mails and sending them.

    Do Until MailList.EOF

            ' This creates the e-mail
            Set MyMail = MyOutlook.CreateItem(olMailItem)
            
            ' This addresses it the e-mail
            MyMail.To = MailList("e-mail")
            
            'This gives the e-mail a subject
            MyMail.Subject = Subjectline$
            
            'This provides the e-mail body
            MyMail.Body = MyBodyText
            
            ' This line will copy the "master" template into a variable
            MyNewBodyText = MyBodyText
            
            ' Now we can replace tokens to our heart's content
            ' without worrying about corrupting the "master" template
            MyNewBodyText = Replace(MyBodyText, "[[Name]]", MailList("Name"))
            MyNewBodyText = Replace(MyNewBodyText, "[[Address]]", MailList("Address"))
            MyNewBodyText = Replace(MyNewBodyText, "[[Address2]]", MailList("Address2"))
            MyNewBodyText = Replace(MyNewBodyText, "[[Phone1]]", MailList("Phone1"))
            MyNewBodyText = Replace(MyNewBodyText, "[[Tour1]]", MailList("Tour1"))
            MyNewBodyText = Replace(MyNewBodyText, "[[Platoon1]]", MailList("Platoon1"))
            MyNewBodyText = Replace(MyNewBodyText, "[[SWITCH]]", MailList("SWITCH"))
            MyMail.Body = MyNewBodyText

            MyMail.Attachments.Add "C:\Users\Dominic\Documents\FALCON\Newsletter Stuff\Newsletter.pdf", olByValue, 1, "Newsletter"
            MyMail.Attachments.Add "C:\Users\Dominic\Documents\FALCON\Newsletter Stuff\Directory.pdf", olByValue, 2, "Directory"
            MyMail.Attachments.Add "C:\Users\Dominic\Documents\FALCON\Newsletter Stuff\DeceasedAll.PDF", olByValue, 3, "Deceased"

            ' To briefly describe:
            ' "C:\Users\Dominic\Documents\FALCON\Newsletter Stuff\Directory.pdf" =
            '  the file you want to attach
            '
            ' olByVaue = how to pass the file.  olByValue attaches it, olByReference creates a shortcut.
            '      the shortcut only works if the file is available locally (via mapped or local drive)
            '
            ' 1 = the position in the outlook message where the attachment goes.  This is ignored by most
            '      other mailers, so you might want to ignore it too.  Using 1 puts the attachment
            '      first in line.
            '
            ' "My Displayname" = If you don't want the attachment's icon string to be "c:\myfile.txt" you
            '      can use this property to change it to something useful, i.e. "4th Qtr Report"

            'This sends it!
             MyMail.Send

            'Some people have asked how to see the e-mail
            'instead of automaticially sending it.
            'Uncomment the next line
            'And comment the "MyMail.Send" line above this.

            'MyMail.Display
        
    'And on to the next one...
    MailList.MoveNext

Loop

 'Cleanup after ourselves
 Set MyMail = Nothing

'Uncomment the next line if you want Outlook to shut down when its done.
'Otherwise, it will stay running.

'MyOutlook.Quit
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function
 
Decided to split the query in two. Ran 150 no problem. Ran second 150 no problem. Not sure why sending 300 at one time does not work but splitting the query in two runs works fine.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top