Mail Gövdesine Tablodan Ayrı Ayrı Bölümleri Alma

[baysevimli]

Merhaba Arkadaşlar,

Aşağıdaki konu hakkında yardımınıza ihtiyacım var.

Mail ekinde gönderdiğim excel tablosunda dikkat ettiyseniz 3 birime ait personellerim var. Ben istiyorum ki Outlook 3 ayrı mail hazırlasın ve her birimin personellerini başlıkla birlikte kopyalayıp mail gövdelerine yapıştırsın. To : kısımında "I" sütununda her birimin karşındaki maile, BBC kısmında ise "J" sütununda her birimin karşısındaki maile göndersin.


Ancak, tabloları mail gövdesine almadan önce aşağıdaki sabit yazımı tablonun üstünde yer alsın.

Sn. Yönetici,

Biriminize ait personellerin kart hareketleri aşağıdaki tabloda mevcuttur.

Bilgilerinize arz ederiz.

 

[baysevimli]

Yardımcı olabilecek kimse yok mu ?

 

[baysevimli]

Arkadaşlar konu hala güncel. Yardımcı olabilecek kimse yok mu ? Acaba soruyu doğru mu anlatamadım ?

 

[Korhan Ayhan]

Örnek dosyayı inceleyiniz.

 

[baysevimli]

Korhan Bey,
Çok teşekkür ederim. Bir sorum daha olacak. Şimdi şirkette kullandığım outlook'dan hem kendi mail adresimle hemde grup mail adresi ile iki şekilde mail gönderebiliyorum. kendi mail adresim örneğin cihat@ner.com grup mail adresimiz ise ik@ner.com ben grup mail adresimden göndersin istiyorum bunu yapabilmek mümkün mü ?

 

[Korhan Ayhan]

Kodun ilk bölümünü aşağıdaki gibi değiştirip deneyiniz.

Kırmızı renkle belirttiğim bölümdeki sayısal değerle oynayıp deneyiniz.

Option Explicit

Sub Mail_Gonder()
    Dim OutApp As Object, OutMail As Object
    Dim Alan As Range, Son As Long, Veri As Range

    Application.ScreenUpdating = False

    On Error Resume Next
    With Sheets("Sayfa1")
        .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("J1"), Unique:=True
         Son = .Cells(Rows.Count, "J").End(3).Row
         For Each Veri In .Range("J2:J" & Son)
             Son = .Cells(Rows.Count, "A").End(3).Row
            .Range("A1:G" & Son).AutoFilter 3, Veri
             Son = .Cells(Rows.Count, "A").End(3).Row
             Set Alan = .Range("A1:G" & Son).SpecialCells(xlCellTypeVisible)
             Set OutApp = CreateObject("Outlook.Application")
             Set OutMail = OutApp.CreateItem(0)
             With OutMail
                .Display
                .To = Veri.Offset(0, 1).Value
                .Cc = ""
                .Bcc = Veri.Offset(0, 2).Value
                .Subject = "Birim Kart Hareketi Raporu"
                .Htmlbody = "<br>Sn. Yönetici,<br>" & _
                            "<br>Biriminize ait personellerin kart hareketleri aşağıdaki tabloda mevcuttur.<br>" & _
                            "<br>Bilgilerinize arz ederiz.<br>" & RangetoHTML(Alan) & .Htmlbody
                [COLOR="Red"].SendUsingAccount = OutApp.Session.Accounts.Item(1)[/COLOR]
                .Send
             End With
         Next
        .ShowAllData
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing

    Application.ScreenUpdating = True
End Sub

 

[baysevimli]

Korhan Bey Kodu güncelledim ama hala kendi mailimden atıyor. Mailin kimden gideceğini M1 hücresinden alabilir mi ?

 

[Korhan Ayhan]

Bahsettiğim bölümdeki sayısal değeri değiştirdiniz mi?

 

[Korhan Ayhan]

M1 hücresindeki hesap mail adresini aşağıdaki şekilde aldırabilirsiniz.

Option Explicit

Sub Mail_Gonder()
    Dim OutApp As Object, OutMail As Object
    Dim Alan As Range, Son As Long, Veri As Range

    Application.ScreenUpdating = False

    On Error Resume Next
    With Sheets("Sayfa1")
        .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("J1"), Unique:=True
         Son = .Cells(Rows.Count, "J").End(3).Row
         For Each Veri In .Range("J2:J" & Son)
             Son = .Cells(Rows.Count, "A").End(3).Row
            .Range("A1:G" & Son).AutoFilter 3, Veri
             Son = .Cells(Rows.Count, "A").End(3).Row
             Set Alan = .Range("A1:G" & Son).SpecialCells(xlCellTypeVisible)
             Set OutApp = CreateObject("Outlook.Application")
             Set OutMail = OutApp.CreateItem(0)
             With OutMail
                .Display
                .To = Veri.Offset(0, 1).Value
                .Cc = ""
                .Bcc = Veri.Offset(0, 2).Value
                .Subject = "Birim Kart Hareketi Raporu"
                .Htmlbody = "<br>Sn. Yönetici,<br>" & _
                            "<br>Biriminize ait personellerin kart hareketleri aşağıdaki tabloda mevcuttur.<br>" & _
                            "<br>Bilgilerinize arz ederiz.<br>" & RangetoHTML(Alan) & .Htmlbody
                .SendUsingAccount = OutApp.Session.Accounts.Item(Range("M1").Value)
                .Send
             End With
         Next
        .ShowAllData
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing

    Application.ScreenUpdating = True
End Sub

 

[baysevimli]

Korhan Bey,

Sayısal değeri değiştirdim olmadı. Ayrıca son yazdığınız kod da olmadı M1' e ikini mail adresimi yani grup mailimi yazdım ama yine kişisel mailimden gönderdi.

 

[Korhan Ayhan]

Araştırmama göre "SendUsingAccount" özelliği 2007 ve sonraki versiyonlarda çalışmaktadır.

Kaynak; http://www.rondebruin.nl/win/s1/outlook/account.htm


Siz profilinizde 2010 ofis kullandığınızı belirtmişsiniz. Eğer bu bilgi doğruysa aşağıdaki adımı inceleyin.

İlk olarak ALT+F11 ile kod editörünü açın.
TOOLS-REFERENCES menüsünü açın.
Açılan listeden "Microsoft Outlook 16.0 Object Library" seçeneğini yapın. (16.0 yazan bölüm sizde farklı olabilir.)
Bu işlemlerden sonra aşağıdaki kodu deneyin.

Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim X As Long

    Set OutApp = CreateObject("Outlook.Application")

    For X = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(X) & " : This is account number " & X
    Next X
End Sub

Bu kod size outlook uygulamasındaki kullanılan hesapları listeleyecektir. Eğer koddan olumlu sonuç alırsanız listeden hangi hesabı ve index numarasını öğrenip ilk 6 nolu mesajımdaki koda adapte edebilirsiniz.

 

[baysevimli]

Korhan Bey,

Söylediklerinizi yaptım. Yalnız Microsoft Outlook 16.0 değil 14.0 vardı onu işareletledim.Son verdiğiniz kodu da alta yapıştırdım ama olmadı yine maalesef acaba ben mi bi yerde hata yapıyorum. Excel dosyası ekte mevcut bi bakabilir misiniz.

 

[Korhan Ayhan]

Son verdiğim kodu çalıştırdığınızda ne sonuç elde ediyorsunuz.

 

[baysevimli]

Hiçbir aksiyon yok. Yine kişisel mailimden atıyor. ama kodu en alta kopyaladım doğru mu kopyaladım.

 

[Korhan Ayhan]

11 nolu mesajımda ki ayarlamayı yaptıktan sonra "Sub Which_Account_Number()" isimli makroyu F8 tuşu ile adım adım çalıştırdığınızda sonuç elde edebiliyor musunuz? Bunu soruyorum.

 

[baysevimli]

Korhan Bey,

F8 ile denedim MsgBox "cihat@hotmail.com : This is account number 1 " uyarısı verdi. Hala kişisel mailimi algılıyor.

 

[Korhan Ayhan]

Gelen mesaja tamam deyip F8 tuşu ile çalıştırmaya devam edin. Sırayla size tanımlı hesapları gösterecektir. Eğer başka hesap için mesaj vermiyorsa bu demektir ki sizin kişisel mailinizden başka tanımlı bir hesap yok. Bu durumda mail attığınızda sizin hesabınız kullanılacaktır.

 

[halit3]

Farklı bir uygulama olarak örnek dosya gönderiyorum sarı alanlar zorunlu doldurulmalı
H ve I sütununa kullanıcı adınızı ve parolanızı yazın B sutünuna mail göndereceğiniz adresleri yazın data sayfasındaki verileri göndermek için Sayfa1 deki form aç düğmesini tıklayın ve kırmızı açılan liste kutusundan kullanıcı seçin ve mail adres listesinden mail göndereceğiniz kişileri seçin ve mail gönder düğmesini tıklayın.

not: bu uygulamada outlookun kurulu olması gerekmez.

 

[Ripper]

Selamlar @baysevimli,

Aynı sorunu bende yaşıyordum @Korhan Ayhan hocamın kodlarını kullandım bende de yine istediğim hücreden hangi mail ile gitmesini istiyorsam ayarı olmadı. Sonra @Korhan Ayhan hocamın kaynak gösterdiği yerden biraz araştırma yapınca. Kendi kodlarımın arasında ve @Korhan Ayhan hocamın kodlarının arasında aşağıdaki kodları görmedim. Bu kodları ekleyince istediğim mail hesabından ve istediğim hücreden bunu belirleme seçeneklerini kullabildim.

Dim OutAccount As Outlook.Account
Set OutAccount = Outapp.Session.Accounts.Item(Range("D7").Value)
Set OutAccount = Nothing

Not: Konunun eski olduğunu biliyorum olurda birisi sorun yaşarsa buradan yine sorununa çözüm bulsun diye yorum yapıyorum.

Bilginize.
Saygılarımla.

 

[ramazancakici]

Araştırmama göre "SendUsingAccount" özelliği 2007 ve sonraki versiyonlarda çalışmaktadır.

Kaynak; http://www.rondebruin.nl/win/s1/outlook/account.htm


Siz profilinizde 2010 ofis kullandığınızı belirtmişsiniz. Eğer bu bilgi doğruysa aşağıdaki adımı inceleyin.

İlk olarak ALT+F11 ile kod editörünü açın.
TOOLS-REFERENCES menüsünü açın.
Açılan listeden "Microsoft Outlook 16.0 Object Library" seçeneğini yapın. (16.0 yazan bölüm sizde farklı olabilir.)
Bu işlemlerden sonra aşağıdaki kodu deneyin.

Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim X As Long

    Set OutApp = CreateObject("Outlook.Application")

    For X = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(X) & " : This is account number " & X
    Next X
End Sub

Bu kod size outlook uygulamasındaki kullanılan hesapları listeleyecektir. Eğer koddan olumlu sonuç alırsanız listeden hangi hesabı ve index numarasını öğrenip ilk 6 nolu mesajımdaki koda adapte edebilirsiniz.

Yardımınız için teşekkürler.