Sending attachement in mail through macro

[kamdardharmesh]

I am using following macro for sending two attachments in one mail.

But in first mail, two attachments are going. In second mail, 4 attachments are going and so on. How to remove earlier attachments? My code is as under.


Pls help.


Regards,

Dharmesh Kamdar

Sub drkthree()
'
' dkthree Macro
'

'

Set fs = CreateObject("Scripting.FileSystemObject&#34
fs.DeleteFile "D:dataPortfolioMacroLostCustomers.xls", force
fs.DeleteFile "D:dataPortfolioMacroTopCustomers.xls", force

For i = 1 To 50
Range("P1&#34 = i

Range("A6&#34.Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Columns("K:K&#34.Select
Selection.ColumnWidth = 22.71
Range("J:J,L:M&#34.Select
Range("L1&#34.Activate
Selection.ColumnWidth = 10.14
Selection.ColumnWidth = 11
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
ActiveWindow.DisplayGridlines = False
Range("A1&#34.Select
Application.DisplayAlerts = False

Columns("A:Q&#34.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P11&#34.Select
Application.CutCopyMode = False

Columns("A:Q&#34.Select
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _
"D:dataPortfolioMacroLostCustomers.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

ActiveWindow.Close
Application.DisplayAlerts = True

'14Aug13
Range("A22&#34.Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Columns("H:H&#34.Select
Selection.ColumnWidth = 22.71
Range("G:G,I:J&#34.Select
Range("I1&#34.Activate
Selection.ColumnWidth = 10.14
Selection.ColumnWidth = 11
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
ActiveWindow.DisplayGridlines = False
Range("A1&#34.Select
Application.DisplayAlerts = False

Columns("A:Q&#34.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P11&#34.Select
Application.CutCopyMode = False

Columns("A:Q&#34.Select
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _
"D:dataPortfolioMacroTopCustomers.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

ActiveWindow.Close
Application.DisplayAlerts = True

'14 Aug 13

'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&#34.Range("A1:N69&#34

'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

With .Item
.to = Range("R1&#34
.CC = Range("S1&#34
'.BCC = ""
.Subject = Range("Q2&#34
.Attachments.Add "D:dataPortfolioMacroLostCustomers.xls"
.Attachments.Add "D:dataPortfolioMacroTopCustomers.xls"
.Send
' Set fs = CreateObject("Scripting.FileSystemObject&#34
' 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