Email atma sorunu.

[unalh]

S. Arkadaşlar,

Şöyle bir makro mevcut bu macro Outlook tan mail gönderiyor bunu Outlook Exprees olarak nasıl değiştirebiliriz.




Private Sub CommandButton1_Click()

Dim bool As Boolean
strRefPath = "C:\Program Files\Microsoft Office\OFFICE12\msoutl.olb" 'ADO
bool = False
For Each ref In ThisWorkbook.VBProject.References
If ref.fullPath = strRefPath Then bool = True
Next
' 'MsgBox "kontroller tamamlandı.": Exit Sub
'<<<<<<<<<<<<<<<<<<<<<<<İŞLEMLER>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim Outlook_Uygulaması As Outlook.Application
Dim Yeni_Mail As Outlook.MailItem
Dim Dosya_Adı As String, Mail_Dosyası As String

Application.ScreenUpdating = False
ActiveSheet.Copy

Mail_Dosyası = "C:\deneme" & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Mail_Dosyası
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.ScreenUpdating = True

Set Outlook_Uygulaması = New Outlook.Application
Set Yeni_Mail = CreateItem(olMailItem)
With Yeni_Mail
.To = "deneme@deneme.com.tr"
.Subject = "Deneme"
.Body = "Bu e-mail eki "
.Attachments.Add Mail_Dosyası
.Display ' Maili ekranda görüntüler.
'.Send ' Maili direk gönderir.
End With
Set Outlook_Uygulaması = Nothing
Set Yeni_Mail = Nothing
Kill Mail_Dosyası
MsgBox "Bu Mail ile " & adr & " adresine " & ShName & " sayfası gönderildi."


End Sub

 

[unalh]

S.a.
Güncel.