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