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

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

Add also the sheet name before cells (2*) in this part of the code
You have problems now if "Sheet1" is not active.

If Dir(Cells(1, FileCell.Column)) < "" Then
.Attachments.Add Cells(1, FileCell.Column).Value
End If


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
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

Ron,

You're an Angel.
Thanks.


--
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