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. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Mail a different files to each person in a range
Hello
I've found this macro on a great website http://www.rondebruin.nl/mail/folder2/files.htm -------------------------------------------- Make a list in Sheet("Sheet1") with In column A : Names of the people In column B : E-mail addresses In column C : Filenames like this C:\Data\Book2.xls (don't have to be Excel files) The Macro will loop through each row in Sheet1 and if there is a E-mail address and a filename that exist in that row it will create a mail with this information and send it. Sub TestFile() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0, 1).Value) "" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value .Attachments.Add cell.Offset(0, 1).Value .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -------------------------------------------------- but there is one problem for me i would like to send few files to one person not only one file. How should I change the macro to do this. File names will be in column C,D,E,F. Thank you for solving my problem. Kind Regards Wano |
#2
|
|||
|
|||
Hi
Try this one Sub TestFile1() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range, FileCell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _ .SpecialCells(xlCellTypeConstants) If Dir(FileCell.Value) "" Then .Attachments.Add FileCell.Value End If Next FileCell .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -- Regards Ron de Bruin http://www.rondebruin.nl wrote in message ups.com... Hello I've found this macro on a great website http://www.rondebruin.nl/mail/folder2/files.htm -------------------------------------------- Make a list in Sheet("Sheet1") with In column A : Names of the people In column B : E-mail addresses In column C : Filenames like this C:\Data\Book2.xls (don't have to be Excel files) The Macro will loop through each row in Sheet1 and if there is a E-mail address and a filename that exist in that row it will create a mail with this information and send it. Sub TestFile() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0, 1).Value) "" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value .Attachments.Add cell.Offset(0, 1).Value .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -------------------------------------------------- but there is one problem for me i would like to send few files to one person not only one file. How should I change the macro to do this. File names will be in column C,D,E,F. Thank you for solving my problem. Kind Regards Wano |
#3
|
|||
|
|||
I update the site with a new macro
Please test it and post back if it is working OK for you http://www.rondebruin.nl/mail/folder2/files.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Ron de Bruin" wrote in message ... Hi Try this one Sub TestFile1() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range, FileCell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _ .SpecialCells(xlCellTypeConstants) If Dir(FileCell.Value) "" Then .Attachments.Add FileCell.Value End If Next FileCell .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -- Regards Ron de Bruin http://www.rondebruin.nl wrote in message ups.com... Hello I've found this macro on a great website http://www.rondebruin.nl/mail/folder2/files.htm -------------------------------------------- Make a list in Sheet("Sheet1") with In column A : Names of the people In column B : E-mail addresses In column C : Filenames like this C:\Data\Book2.xls (don't have to be Excel files) The Macro will loop through each row in Sheet1 and if there is a E-mail address and a filename that exist in that row it will create a mail with this information and send it. Sub TestFile() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0, 1).Value) "" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value .Attachments.Add cell.Offset(0, 1).Value .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -------------------------------------------------- but there is one problem for me i would like to send few files to one person not only one file. How should I change the macro to do this. File names will be in column C,D,E,F. Thank you for solving my problem. Kind Regards Wano |
#4
|
|||
|
|||
Hi
I made a small change to avoid that the macro stop when there is one row without a file name Sub TestFile() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range, FileCell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _ Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1")) 0 Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value 'Enter the file names in the C:F column in each row 'You can make the range bigger if you want, only change the column not the 1 For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _ .SpecialCells(xlCellTypeConstants) If Trim(FileCell) "" Then If Dir(FileCell.Value) "" Then .Attachments.Add FileCell.Value End If End If Next FileCell .Send 'Or use Display End With Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -- Regards Ron de Bruin http://www.rondebruin.nl "Ron de Bruin" wrote in message ... I update the site with a new macro Please test it and post back if it is working OK for you http://www.rondebruin.nl/mail/folder2/files.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Ron de Bruin" wrote in message ... Hi Try this one Sub TestFile1() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range, FileCell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _ .SpecialCells(xlCellTypeConstants) If Dir(FileCell.Value) "" Then .Attachments.Add FileCell.Value End If Next FileCell .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -- Regards Ron de Bruin http://www.rondebruin.nl wrote in message ups.com... Hello I've found this macro on a great website http://www.rondebruin.nl/mail/folder2/files.htm -------------------------------------------- Make a list in Sheet("Sheet1") with In column A : Names of the people In column B : E-mail addresses In column C : Filenames like this C:\Data\Book2.xls (don't have to be Excel files) The Macro will loop through each row in Sheet1 and if there is a E-mail address and a filename that exist in that row it will create a mail with this information and send it. Sub TestFile() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants) If cell.Offset(0, 1).Value "" Then If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0, 1).Value) "" Then Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value .Attachments.Add cell.Offset(0, 1).Value .Display 'Or use Display End With Set OutMail = Nothing End If End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub -------------------------------------------------- but there is one problem for me i would like to send few files to one person not only one file. How should I change the macro to do this. File names will be in column C,D,E,F. Thank you for solving my problem. Kind Regards Wano |
#5
|
|||
|
|||
Ron de Bruin napisal(a): Hi I made a small change to avoid that the macro stop when there is one row without a file name ..... Sub TestFile() ..... End Sub -- Regards Ron de Bruin http://www.rondebruin.nl Hi Works PERFECT. You're genius. Now I save some time and few mistakes. Thank you. You helped me a lot. Wano |
#6
|
|||
|
|||
You are welcome
Thanks for the feedback -- Regards Ron de Bruin http://www.rondebruin.nl wrote in message ups.com... Ron de Bruin napisal(a): Hi I made a small change to avoid that the macro stop when there is one row without a file name ..... Sub TestFile() ..... End Sub -- Regards Ron de Bruin http://www.rondebruin.nl Hi Works PERFECT. You're genius. Now I save some time and few mistakes. Thank you. You helped me a lot. Wano |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Send email via yahoo account | Ray | Outlook Express | 10 | June 8th, 2005 12:00 AM |
Cannot access read-only documents. | tomgillane | General Discussion | 14 | February 7th, 2005 10:53 PM |
Copies upon copies in OE mail files | D. Stang | Outlook Express | 9 | September 10th, 2004 01:19 AM |
previously read mail kept on regenerating itself | wendi | Outlook Express | 4 | August 9th, 2004 12:34 AM |
Move Mail files from one disk to another | Amorosa | Outlook Express | 4 | July 28th, 2004 09:27 PM |