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(xlCellTypeConstants)
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" <as_sass.1x2eae_1129583151.3756@excelforum-nospam.com> wrote in message
news:as_sass.1x2eae_1129583151.3756@excelforum-nospam.com...
>
> 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
> john@doe.com 1 1
> bert@blitz.com 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
>
> Re: 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(xlCellTypeConstants)
> 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
>