Solved

Repetitive Task

Posted on 2008-10-08
8
211 Views
Last Modified: 2012-05-05
Hello Experts,

I have a form that I use to email many reports to the same group of people. Currently I use:


Dim toMailRecipient, ccMailRecipient As String

Let toMailRecipient = "ManyEmails@Removed.com"
   
Let ccMailRecipient = "AFewEmails@Removed.com"
   
Each time that I need to update the email list I have to change in in many places.

I want to know a way to use one email list for toMailRecipient & one list for ccMailRecipient and reference it so that I only have to make one update.

Please be very detailed in your response.
0
Comment
Question by:eddiepardon
  • 4
  • 4
8 Comments
 
LVL 18

Expert Comment

by:jmoss111
ID: 22672488
What mail client are you using eddie?

Jim
0
 

Author Comment

by:eddiepardon
ID: 22672573
Jim,

The mail client is Outlook 2003.

0
 
LVL 18

Expert Comment

by:jmoss111
ID: 22672708
I have examples of emailing but I only use CDO to get around the Outlook security which won't help you. I maintain a table of email addresses in Access or SQL Server; only one place to add, change or delete email addresses.

Jim
0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 

Author Comment

by:eddiepardon
ID: 22672869
Jim,

So if created a table say tblEmailAddress two fields say toEmailAddress & ccEmailAddress how could I reference that.

What would the code be? Also I would need to add the separator (;) between each address.

I have pasted the code I am currently using so that you can understand what I am doing.

Private Sub cmdSendEmail_Click()
    'On Error Resume Next
    Dim toMailRecipient, ccMailRecipient As String
    Dim fso As New FileSystemObject
    Dim fold As Folder
    Dim f As File
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim dteToday As Date
    dteToday = Date
   
    Let toMailRecipient = "emails@removed.com"
   
    Let ccMailRecipient = "emails@removed.com"
   
   
   
    Set fold = fso.GetFolder("C:\Documents and Settings\pardoe2\My Documents\PMO\Reports\Blank Solution Tabs\")
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
   
   
 
   
            With MailOutLook
            .To = toMailRecipient
            .CC = ccMailRecipient
            .Subject = "Blank Solution Tab in Remedy..."
            .HTMLBody = "Package Managers,<br><br>Attached is a listing of all the Resolved/Closed" & _
             " tickets so far for the current month that have blank solution tabs. Review these" & _
             " and have the teams make the corrections in Remedy. Thanks!<br><br>"
                For Each f In fold.Files
                    .Attachments.Add f.Path
                Next
            .Send
        End With
   
    Set fold = Nothing
    Set fso = Nothing
     
    Me.lblSolutionSent.Visible = True
    Me.cmdMinimize.SetFocus
    Me.cmdSendEmail.Visible = False
    Me.cmdSendAllEmail.Visible = False
    MsgBox "The Blank Solution Tab Report Has Been Emailed. "
   
 

End Sub
0
 
LVL 18

Accepted Solution

by:
jmoss111 earned 500 total points
ID: 22674338
All I did was add a loop for grabbing addresses from address table. I didn't check any of your other code. You're going to have problems with Outlook Security; search for ClickYes for simple fix.

Jim
Private Sub cmdSendEmail_Click()
    'On Error Resume Next
    Dim toMailRecipient, ccMailRecipient As String
    Dim fso As New FileSystemObject
    Dim fold As Folder
    Dim f As File
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim dteToday As Date
    dteToday = Date
'==============================
    Dim db AS DAO.Database
    DIm rs AS DAO.Recordset
'==============================
	Set fold = fso.GetFolder("C:\Documents and Settings\pardoe2\My Documents\PMO\Reports\Blank Solution Tabs\")
    	Set appOutLook = CreateObject("Outlook.Application")
    	Set MailOutLook = appOutLook.CreateItem(olMailItem)
	Set db = Currentdb
	Set rs = Db.OpenRecordset("SELECT Recip, ccRecip FROM tblMyMailList;")
    
    	rs.MoveFirst
        Do While Not rs.EOF
    
         toMailRecipient = rs!Recip		
         ccMailRecipient = rs!ccRecip
    
    
  
   
           With MailOutLook
            .To = toMailRecipient
            .CC = ccMailRecipient
            .Subject = "Blank Solution Tab in Remedy..."
            .HTMLBody = "Package Managers,<br><br>Attached is a listing of all the Resolved/Closed" & _
             " tickets so far for the current month that have blank solution tabs. Review these" & _
             " and have the teams make the corrections in Remedy. Thanks!<br><br>"
                For Each f In fold.Files
            .Attachments.Add f.Path
                Next
            .Send
           End With
          rs.Movenext
	  Loop
    
    Set fold = Nothing
    Set fso = Nothing
    set rs = Nothing
    Set db = Nothing	  
    Me.lblSolutionSent.Visible = True
    Me.cmdMinimize.SetFocus
    Me.cmdSendEmail.Visible = False
    Me.cmdSendAllEmail.Visible = False
    MsgBox "The Blank Solution Tab Report Has Been Emailed. "
    
  
 
End Sub

Open in new window

0
 

Author Comment

by:eddiepardon
ID: 22679105
Jim,

Works like a champ! Here is what I did based upon your suggestion:

Dim strTo As String
    Dim strCC As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
   
    strTo = ""
    strCC = ""
   
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT toEmailAddress FROM tblEmailAddress;")
   
        rs.MoveFirst
        Do While Not rs.EOF
   
         strTo = strTo + rs!toEmailAddress
        rs.MoveNext
        Loop
    toMailRecipient = strTo
    Set rs = Nothing
    Set db = Nothing
   
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT ccEmailAddress FROM tblEmailAddress;")
   
        rs.MoveFirst
        Do While Not rs.EOF
   
         strCC = strTo + rs!ccEmailAddress
        rs.MoveNext
        Loop
    ccMailRecipient = strCC
    Set rs = Nothing
    Set db = Nothing
   
0
 

Author Closing Comment

by:eddiepardon
ID: 31504387
Thanks for your help!
0
 
LVL 18

Expert Comment

by:jmoss111
ID: 22680167
Hi eddie,

Glad that I could help you out.

Jim
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

805 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question