LinkBack URL
About LinkBacks
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
Register To Reply
Bookmarks