İyi Akşamlar,
Aşağıdaki E-Mail gönderimi ile ilgili kod sorunsuz olarak çalışıyor. Benim istediğim Gönderen kısmını değiştirmek. .From olarak baktım ama bir şey bulamadım. Mail gönderdiğimde gönderen msonmez olarak değilde örnek SÖNMEZ A.Ş olarak çıksın. Kod yazarak yapılabilir diye düşünüyorum.
Yardımlarınız için Teşekkürler.
**********************************************************
Sub subeler_e_mail()
'
' msonmez Macro
' Macro recorded 23.12.2005 by MSONMEZ
'
mesaj = MsgBox(" DİKKAT! Tüm Şubelere E-Mail Gönderilecek Eminmisiniz ? !!!", vbYesNo, "DBA")
If mesaj = vbNo Then MsgBox " GÖNDERİM İŞLEMİ İPTAL EDİLDİ.", vbCritical, "DBA": Exit Sub
If Range("E2") = 0 Then
MsgBox " herhangi bir giriş olmadığı için gönderim iptal edilmiştir."
Exit Sub
End If
Sheets("Ana_Sayfa").Select
Range("A1").Select
On Error Resume Next
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim dosya As String
i = 2
While Cells(i, 1) <> ""
dosya = Cells(i, 6)
Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = Cells(i, 3)
.CC = Cells(i, 4)
.Subject = Cells(i, 5)
.Body = Cells(i, 6) & vbCrLf & "Saygılarımla," & vbCrLf & "Murat Sönmez" & Chr(13)
.Attachments.Add dosya
.ReadReceiptRequested = False
.Save
.Send
End With
i = i + 1
Set NewMail = Nothing
Set OutApp = Nothing
Wend
End Sub
Aşağıdaki E-Mail gönderimi ile ilgili kod sorunsuz olarak çalışıyor. Benim istediğim Gönderen kısmını değiştirmek. .From olarak baktım ama bir şey bulamadım. Mail gönderdiğimde gönderen msonmez olarak değilde örnek SÖNMEZ A.Ş olarak çıksın. Kod yazarak yapılabilir diye düşünüyorum.
Yardımlarınız için Teşekkürler.
**********************************************************
Sub subeler_e_mail()
'
' msonmez Macro
' Macro recorded 23.12.2005 by MSONMEZ
'
mesaj = MsgBox(" DİKKAT! Tüm Şubelere E-Mail Gönderilecek Eminmisiniz ? !!!", vbYesNo, "DBA")
If mesaj = vbNo Then MsgBox " GÖNDERİM İŞLEMİ İPTAL EDİLDİ.", vbCritical, "DBA": Exit Sub
If Range("E2") = 0 Then
MsgBox " herhangi bir giriş olmadığı için gönderim iptal edilmiştir."
Exit Sub
End If
Sheets("Ana_Sayfa").Select
Range("A1").Select
On Error Resume Next
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim dosya As String
i = 2
While Cells(i, 1) <> ""
dosya = Cells(i, 6)
Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = Cells(i, 3)
.CC = Cells(i, 4)
.Subject = Cells(i, 5)
.Body = Cells(i, 6) & vbCrLf & "Saygılarımla," & vbCrLf & "Murat Sönmez" & Chr(13)
.Attachments.Add dosya
.ReadReceiptRequested = False
.Save
.Send
End With
i = i + 1
Set NewMail = Nothing
Set OutApp = Nothing
Wend
End Sub