?
Solved

Repetitive Task

Posted on 2008-10-08
8
Medium Priority
?
217 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

 

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 2000 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

NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

Question has a verified solution.

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

Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

764 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