Hi!

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

My problem is that I can't get it to work when I change the column
that the various information is in. Additionally, I want to introduce
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 FIRS
row contains the file names and paths, and every subsequent row contain
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 receive
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 on
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 I
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 no
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.n

--
as_sas
-----------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...nfo&userid=906
View this thread: http://www.excelforum.com/showthread.php?threadid=47695