Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email a range xls files in a folder to recipients listed in worksheet
Hi all,
Can someone point me in the right direction? I have a list of xls files in a folder which I need to email. Each file has a cover page that has named ranges which has the details of who I want to send it to and the subject. I'm hoping to find and I believe the best way to do it is to have a macro that will loop through each file, open it and send the email automatically. This is what I have. Named ranges: worksheet name = cover person1, person2, person3, email1, email2, email3, ccdescription One thing I should note is that person1 will always be used but person2 & person3 may not be used and be blank. I've been looking at this link - http://www.rondebruin.nl/mail/folder2/mail1.htm and based on this, I'm guessing that it would be something like.... Sub loopworkbooks() For each workbook in folder Open workbook Call Sub Mail_workbook_Outlook Close workbook and do not save End Sub Sub Mail_workbook_Outlook_1() 'Working in 2000-2007 'This example send the last saved version of the Activeworkbook Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = activeworkbook.sheetname.email1 & ...email2 & ...email3 .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add ActiveWorkbook.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub Any assistance would be sincerely appreciated. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email a range xls files in a folder to recipients listed in worksheet
Try this Sub loopworkbooks() Dim BKName As String Dim DistList As String Dim BKNames() As String 'create sdistribution list With ActiveWorkbook.ActiveSheet 'get distribution list from column A LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set DistributionRange = .Range("A1:A" & LastRow) 'make string of email address seperated by semicolon DistList = "" For Each cell In DistributionRange If DistList = "" Then DistList = cell.Value Else 'add semicolon between email names DistList = DistList & ";" & cell.Value End If Next cell End With Folder = "C:\temp\" 'Create an array of book names ArrayCount = 0 FName = Dir(Folder & "*.xls") Do While FName < "" BKName = Folder & FName ReDim Preserve BKNames(0 To ArrayCount) BKNames(ArrayCount) = BKName ArrayCount = ArrayCount + 1 FName = Dir() Loop Call Mail_workbook_Outlook_1(BKNames, DistList) End Sub Sub Mail_workbook_Outlook_1(BKNames As Variant, _ DistList As String) 'Working in 2000-2007 'This example send the last saved version of the Activeworkbook Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Dim OutMail As Object Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = DistList .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" For Each bk In BKNames .Attachments.Add bk Next bk .Send 'or use .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=148971 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Attach Files Listed in Columns with Email | Excel Programming | |||
Find & Copy Files Listed in Excel Worksheet ? | Excel Programming | |||
Send email to multiple recipients using VBA | Excel Programming | |||
microsoft email range code. Add to Sent Items folder? | Excel Programming | |||
How to exctract files listed in an Excel-file from a folder? | Excel Discussion (Misc queries) |