PDA

View Full Version : CDO attaches all file in Loop



xls
06-16-2009, 10:56 PM
i am using CDO to sent email using rondebruin code.
I have mofied code to send email with attachment.

It loop thru range & send email to every person in range with attachment.

What happens is that ita attches attachment in cumulative.

eg. for range 1 it attches attchmnt for range1,
for range 2 it attches attchmnt for range1 & range 2
for range 3 it attches attchmnt for range1, range 2 & range 3.
some part of code is given below.

how to solve prob.


.
.
.
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ""
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = ""
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= ""
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With


Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

For Each sCell In R

att = Range("C4").Value
If Dir(att) = "" Then
GoTo Last:
Else


With iMsg
Set .Configuration = iConf
.to = ""
.CC = ""
.Subject = ""
.AddAttachment (att)
.HTMLBody = RangetoHTML(rng)
.Send
End With
End If

Last:
.
.


Next sCell

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub