A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Excel » General Discussion
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

Loop through email address list to send e-mails



 
 
Thread Tools Display Modes
  #1  
Old April 12th, 2005, 08:37 AM
Paul.
external usenet poster
 
Posts: n/a
Default Loop through email address list to send e-mails

Hi Every one,

Following is a code that prints out weekly individual task lists from a
master Critical Path.

The code first creates a list of unique individuals on a temporary page,
-then filter my critical path in a Column called "Next week" to only show
action requiring follow-up on following week.
-then prints-out a list of individuals who will receive task lists,
-and finaly loops through alll values in "MyUniqueRng" to filter and print
out the list name by name.

What I would like to do, is instead of Printing-out these individuals task
lists,
sending them by e-mail whith outlook
Provided that all names are listed on another separate sheet (Whole list of
employees) and that I would write their e-mail addresses on a column at the
right of the "Name" column, I assume that by a loop through the range
"MyUniqueRng" combined to a V-Lookup these addresses could easily be pasted
in outlook to send individual e-mails.

It would be great If somebody could assist me in this matter.

Thanks,

Paul



Sub Print_Next_Weeek_Task_Lists()

Application.ScreenUpdating = False
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myRng2 As Range
Dim myUniqueRng As Range
Dim myCell As Range


Set curWks = Sheets("Critical Path")
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell))
Set myRng2 = .Range("A5", .Cells.SpecialCells(xlCellTypeLastCell))
myRng2.AutoFilter Field:=16, Criteria1:=""
myRng.Columns(4).Copy _
Destination:=newWks.Range("a1")
With newWks
.Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True
.Range("b:b").Sort Key1:=Range("b1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp))
End With

With Sheets("Task List Distribution NW") ' Prints Task List
Distribution Record
myUniqueRng.Copy
Sheets("Task List Distribution NW").Select
Range("A7").PasteSpecial (xlPasteValues)
.PrintOut Copies:=1, preview:=False
Range("A7:A60").ClearContents
End With


.Range("L4").Value = "Next Week"
For Each myCell In myUniqueRng.Cells
L
myRng2.AutoFilter Field:=4, Criteria1:=myCell.Value O
.Range("O3").Value = myCell.Value
O
.PrintOut Copies:=1, preview:=False
P
Next myCell

.Range("O3:P3").ClearContents
.Range("L4").ClearContents
If .FilterMode Then
.ShowAllData
End If

End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
  #2  
Old April 12th, 2005, 12:41 PM
Duke Carey
external usenet poster
 
Posts: n/a
Default

There are people here who are clever enough to help you handle this in Excel,
but I'll point out that Word XP (maybe earlier versions, too) have an option
to mailmerge to Outlook emails. It sounds pretty easy, and may be easier
than handling it all in Excel.



"Paul." wrote:

Hi Every one,

Following is a code that prints out weekly individual task lists from a
master Critical Path.

The code first creates a list of unique individuals on a temporary page,
-then filter my critical path in a Column called "Next week" to only show
action requiring follow-up on following week.
-then prints-out a list of individuals who will receive task lists,
-and finaly loops through alll values in "MyUniqueRng" to filter and print
out the list name by name.

What I would like to do, is instead of Printing-out these individuals task
lists,
sending them by e-mail whith outlook
Provided that all names are listed on another separate sheet (Whole list of
employees) and that I would write their e-mail addresses on a column at the
right of the "Name" column, I assume that by a loop through the range
"MyUniqueRng" combined to a V-Lookup these addresses could easily be pasted
in outlook to send individual e-mails.

It would be great If somebody could assist me in this matter.

Thanks,

Paul



Sub Print_Next_Weeek_Task_Lists()

Application.ScreenUpdating = False
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myRng2 As Range
Dim myUniqueRng As Range
Dim myCell As Range


Set curWks = Sheets("Critical Path")
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell))
Set myRng2 = .Range("A5", .Cells.SpecialCells(xlCellTypeLastCell))
myRng2.AutoFilter Field:=16, Criteria1:=""
myRng.Columns(4).Copy _
Destination:=newWks.Range("a1")
With newWks
.Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True
.Range("b:b").Sort Key1:=Range("b1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp))
End With

With Sheets("Task List Distribution NW") ' Prints Task List
Distribution Record
myUniqueRng.Copy
Sheets("Task List Distribution NW").Select
Range("A7").PasteSpecial (xlPasteValues)
.PrintOut Copies:=1, preview:=False
Range("A7:A60").ClearContents
End With


.Range("L4").Value = "Next Week"
For Each myCell In myUniqueRng.Cells
L
myRng2.AutoFilter Field:=4, Criteria1:=myCell.Value O
.Range("O3").Value = myCell.Value
O
.PrintOut Copies:=1, preview:=False
P
Next myCell

.Range("O3:P3").ClearContents
.Range("L4").ClearContents
If .FilterMode Then
.ShowAllData
End If

End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Send from Alternative email address Youssef Rihani General Discussion 5 June 13th, 2005 09:03 PM
Improve the Address Book Bill Molony General Discussions 10 February 18th, 2005 12:49 AM
Union Query Not Returning A Value Jeff G Running & Setting Up Queries 2 October 19th, 2004 05:47 PM
error message - server rejecting recipient Ken Outlook Express 5 August 20th, 2004 06:39 PM


All times are GMT +1. The time now is 03:15 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.