Mail gönderme problemi

[hasaona]

Merhaba;

Mail olarak göndermek istediğim karşı tarafa dosya uzantısı xls olarak gönderiyor fakat makro uyarısı veriyor. Benim istediğimde xls uzantısı olacak fakat makro uyarısı vermeyecek şekilde olacak.

Arkadaşlar yardımlarınızı rica ederim




Private Sub CommandButton6_Click()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

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

Set Sourcewb = ThisWorkbook

ActiveSheet.Copy
Set Destwb = ActiveWorkbook

With Destwb
FileExtStr = ".xls": FileFormatNum = 50
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Şablon " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "ııı889*91989@windowslive.com"
.CC = ""
.BCC = ""
.Subject = "Tanım Talebi "
.Body = "Merhaba" & vbNewLine & vbNewLine & "Ekteki dosya tanımlamanızı rica ederim"

.Attachments.Add Destwb.FullName
.Send
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

 

[halit3]

Kırmızı yerlerin arasına ekle kodu

[COLOR="Red"]Set Destwb = ActiveWorkbook[/COLOR]

ActiveSheet.DrawingObjects.Delete
For Each ModX In ActiveWorkbook.VBProject.VBComponents
If ModX.Type = 100 Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
End If
Next


[COLOR="red"]With Destwb[/COLOR]