Solved

Repetitive Task

Posted on 2008-10-08
8
209 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
 

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

 
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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

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

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

911 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now