Excel den mail gönderimi ile ilgili düzenleme...

[umutsancar]

4 sıkıntım var,

1.si, aşağıdaki kodlarla Eposta gönderebiliyorum, ancak ataça eklenen dosyanın boyutu yaklaşık 700Kb. Bu sheet için fazla. Bunu optimize edebilir miyiz?

2.si; kodlar arasında "***" olan kısma silme uyarısı çıkmaması için ne yazmam gerekiyor?

3.sü; .Body kısmındaki değerleri alt alta nasıl yazabilirim? Bu şekilde tek bir satırda gözüküyor.

4.sü ise mail ile ataçta gönderilen tablo açılışta aşağıdaki hatayı çıkarıyor. Sorun nereden kaynaklanıyor acaba!?

Yardımlarınız için şimdiden teşekkürler

Sub PostaGonder()
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim ShName As String, WbName As String
Dim i As Integer
Dim ModX As Object, VBComp As Object
Sheets("MAIL").Select
Sheets("MAIL").Select
Sheets("MAIL").Copy Before:=Sheets(1)
Sheets("MAIL (2)").Select
Sheets("MAIL (2)").Name = "TOMAIL"
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ShName = ActiveSheet.Name
WbName = "C:\" & ShName & ".xls"

ThisWorkbook.SaveCopyAs WbName
Application.DisplayAlerts = False
Workbooks.Open WbName
For i = Sheets.Count To 1 Step -1
If ActiveWorkbook.Sheets(i).Name <> ShName Then Sheets(i).Delete
Next

On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
Next
On Error GoTo 0
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=True
Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = Sheets("XXXX").Range("e6").Text
.Subject = "Fiyat Teklifimiz"
.Body = "AORT Bilişim Hizmetleri, Satış Departmanı, " & Sheets("XXXX").Range("f24").Text
.Attachments.Add WbName
.Save
.Send
End With
Set NewMail = Nothing
Set OutApp = Nothing
Set VBComp = Nothing
Kill WbName
***
Sheets("TOMAIL").Delete

End Sub

 

[bezl]

2. sorunun cevabı için

Application.DisplayAlerts = True

end sub

dan önceye al