Hi as_sass

The original macro is here
http://www.rondebruin.nl/mail/folder2/files.htm


Try this tester with the mail addresses in column K and the file names in L1:CW1
The name in column J (you can change that)

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("K").Cells.SpecialCells(x lCellTypeConstants)
If cell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _
Sheets("Sheet1").Cells(cell.Row, 1).Range("L1:CW1")) 0 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("L1:CW1") _
.SpecialCells(xlCellTypeConstants)
If FileCell.Value = 1 Then
If Dir(Cells(1, FileCell.Column)) < "" Then
.Attachments.Add Cells(1, FileCell.Column).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


"as_sass" wrote in message
...

Hi!

There's this great macro for emailing several files to people that I
found here. The macro and changes that Ron made to it (see below) are
included at the bottom of this post.

My problem is that I can't get it to work when I change the columns
that the various information is in. Additionally, I want to introduce a
minor change to make it more efficient. Who can help?

DETAILS:

- Want to change the column that contains emails to "K".
- Want to change range that contains files to L:CW

ADDITIONAL CHANGE:

- Can you manipulate the macro so that only the L:CW range in the FIRST
row contains the file names and paths, and every subsequent row contains
only a single value (e.g., "1") if the file needs to be sent out?

E.G.:

A B ... K ... L ... CW
email C:\test1.txt C:\test2.txt
1 1
1

-- John receives files test1.txt and test2.txt, while Bert receives
only file test2.txt



Thanks for your help!

sass





--------------------------------------
ORIGINAL POST:


Ron de Bruin
Guest Posts: n/a

Mail a different files to each person in a range

--------------------------------------------------------------------------------

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


--
as_sass
------------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...fo&userid=9065
View this thread: http://www.excelforum.com/showthread...hreadid=476953