Macro to send mail - Error [SOLVED]

[kamdardharmesh]

I am trying to use a macro to send mails with a different attachment for each one. Macro is ready.


Problem-

It is sending earlier attahchement as well in the next mail. in First mail, only one attachment. Second mail, it is sending two, third mail three and so on.


how to prevent it?


My code is as under.

Regards,

Dharmesh

[pre]

Sub drkthree()
'
' dkthree Macro
'

'
For i = 1 To 3
Range("P1") = i

Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Columns("K:K").Select
Selection.ColumnWidth = 22.71
Range("J:J,L:M").Select
Range("L1").Activate
Selection.ColumnWidth = 10.14
Selection.ColumnWidth = 11
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
ActiveWindow.DisplayGridlines = False
Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:Usersdharmesh4033DesktopPortfolioMacroCustomers.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
'End Sub

'Sub drktwo()
'
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range

On Error GoTo StopMacro

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

'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("Sheet4").Range("A1:N54")

'Remember the activesheet
Set AWorksheet = ActiveSheet

With Sendrng

' Select the worksheet with the range you want to send
.Parent.Select

'Remember the ActiveCell on that worksheet
Set rng = ActiveCell

'Select the range you want to mail
.Select

' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope

' Set the optional introduction field thats adds
' some header text to the email body.
'.Introduction = "This is test mail 2."

With .Item
.To = Range("R1")
.CC = Range("S1")
'.BCC = ""
.Subject = Range("Q2")
.Attachments.Add "C:Usersdharmesh4033DesktopPortfolioMacroCustomers.xls"
.Send
'    Set fs = CreateObject("Scripting.FileSystemObject")
'  fs.DeleteFile "C:Usersdharmesh4033DesktopPortfolioMacroCustomers.xls", force
End With

End With

'select the original ActiveCell
rng.Select
End With

'Activate the sheet that was active before you run the macro
AWorksheet.Select

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

ActiveWorkbook.EnvelopeVisible = False

Next i

End Sub

[/pre]

 

[Luke M]

When you send mail with the mail evenlope, it doesn't get cleared after the send. You're changing the subject and to line, so those don't get affected, but the attachment section you just keep adding to. We can add a few lines to clear out old attachments. Starting on line 68 of your code, put this block in:

[pre]

With .Parent.MailEnvelope 'Already exists in your code

'New stuff
'Clear previous attachments
For x = 1 To .Item.Attachments.Count
.Item.Attachments(x).Delete
Next x

'continue on with code

[/pre]

 

[kamdardharmesh]

Thank you very much! Now It is working fine.

Really, appreciate speed & quality.

Thanks!

Regards

Dharmesh Kamdar