Boa tarde colegas, estou com problema em uma macro que envia e-mails, a função dela é a seguinte, pega um relatório, divide de 3000 em 3000 linhas e vai enviando por e-mail, a primeira ela roda, mas na segunda vez que vai enviar o e-mail da um erro "O método do objeto MailEnvelope worksheet falhou" alguém pode me ajudar? segue a macro abaixo (As outras planilhas que ele abre não possuem macro...):

Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Plan1").Select
Range("A1:BK1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
ChDir "D:OS7 - EMAIL"
Workbooks.Open Filename:="D:EMAILRel.xlsx"
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$BK").AutoFilter Field:=1, Criteria1:="FLO"
Range("A1:BK1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AtOS7.xlsm").Activate
ActiveSheet.Paste
Windows("Rel.xlsx").Activate
ActiveWindow.Close True

Dim valor As Integer
valor = Range("BM1").Select

While valor < 0 'Enquanto o valor de linhas for mais que 0 faça
Sheets("Plan1").Select
ChDir "D:OS7 - EMAIL"
Workbooks.Open Filename:="D:EMAILOS7.xlsx"
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.ClearContents
Windows("AtOS7.xlsm").Activate
Range("A1:BK3000").Select
Selection.Copy
Windows("OS7.xlsx").Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWindow.Close
Selection.Delete Shift:=xlUp
Sheets("Plan2").Select

'-------- Mandar Email
With ActiveSheet.MailEnvelope
.Introduction = "OS7!!!"
.Item.To = "sandro.luiz@"
.Item.Subject = "OS7 até " & Format(Date, "MMM/YYYY")
.Item.Attachments.Add "D:EMAILOS7.xlsx"
.Item.display
.Item.Send
End With
'-------- FIM Mandar Email
Wend
ActiveWorkbook.Save
End Sub