Outlooktan mail atarken hesaplar kısmını otomatik seçtirmek

Korhan Ayhan · 19 Haziran 2008

Selamlar,

Arkadaşlar Outlooktan mail atarken aşağıdaki şekilde kod yapısı kullanıyoruz. Kırmızı renkle belirttiğim kısmı kod bloğuna nasıl ekleyebiliriz. Yani maili göndermeden önce HESAPLAR bölümünden 2. seçeneği otomatik seçtirmek istiyorum.

Kod:

[FONT=Arial]    With OutMail[/FONT]
[FONT=Arial]       .To = "[EMAIL="test@test.com"]test@test.com[/EMAIL]"[/FONT]
[FONT=Arial]       .CC = ""[/FONT]
[FONT=Arial]       .BCC = ""[/FONT]
[FONT=Arial]       .Subject = "Deneme"[/FONT]
[FONT=Arial]       .Body = ""[/FONT]
[FONT=Arial]       .Attachments.Add Dosya[/FONT]
[FONT=Arial]       [COLOR=red][B].Hesaplar = "XXXXX Mail"[/B][/COLOR][/FONT]
[FONT=Arial]       .send[/FONT]
[FONT=Arial]   End With[/FONT]

Korhan Ayhan · 19 Haziran 2008

Selamlar,

Arkadaşlar konuyla ilgili hem forumda hemde nette araştırma yaptım fakat bir çözüm bulamadım. Fikirlerinizi bekliyorum.

Ferhat Pazarçevirdi · 19 Haziran 2008

Korhan bey,

Deneme şansım olmadı ama aşağıdaki gibi bir yapı düşünebilirsiniz.

Kod:

[COLOR=red]Dim oLook As Outlook.Application[/COLOR]
Dim outMail As Outlook.MailItem
[LEFT]'............
'............
With OutMail
       .To = "[EMAIL="test@test.com"]test@test.com[/EMAIL]"
       .CC = ""
       .BCC = ""
       .Subject = "Deneme"
       .Body = ""
       .Attachments.Add Dosya
[COLOR=red]      .SendUsingAccount = oLook.Session.Accounts.Item([B]2[/B])[/COLOR]
       .send
End With[/LEFT]

Korhan Ayhan · 20 Haziran 2008

Selamlar,

Ferhat bey maalesef verdiğiniz kod çalışmadı. Kullandığım kodun tamamı aşağıdaki şekildedir. Acaba uygularken bir şeyimi atladım. Yardımlarınız için tekrar teşekkür ederim.

Kod:

Sub MA&#304;L_G&#214;NDER()
    On Error Resume Next
    Dim APP As Outlook.Application
    Dim POSTA As Outlook.MailItem
    Dim MYFILE As String
    Set SML = Sheets("MARKET_L&#304;STE")
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    MYFILE = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    Set APP = CreateObject("Outlook.Application")
    Set POSTA = APP.CreateItem(olMailItem)
    With POSTA
    .To = "Deneme"
    .CC = ""
    .BCC = ""
    .Subject = SML.[A2]
    '.Body = ""
    .Attachments.Add MYFILE
    .Display
    [COLOR=red].SendUsingAccount = APP.Session.Accounts.Item(2)[/COLOR]
    '.Send
    End With
    Application.DisplayAlerts = True
    Set SML = Nothing
End Sub

Ferhat Pazarçevirdi · 20 Haziran 2008

Korhan bey, şu şekilde kodları revize ettim. İnceleyiniz.

Kod:

Sub MAİL_GÖNDER()
    Dim APP As Outlook.Application
    Dim appNS As Outlook.Namespace
    Dim appAcct As Outlook.Account
    Dim POSTA As Outlook.MailItem
    Dim MYFILE As String
    
    Set SML = Sheets("MARKET_LİSTE")
    ActiveWorkbook.Save
    MYFILE = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    
    Set APP = CreateObject("Outlook.Application")
    
    Set appNS = APP.GetNamespace("MAPI")
    appNS.Logon
    
[COLOR=darkgreen]    'Bu satır, 2 nolu hesabı kullanmak için ...[/COLOR]
    Set appAcct = APP.Session.Accounts.Item(2)
 
    Set POSTA = APP.CreateItem(olMailItem)
    With POSTA
        .To = "Deneme"
        .CC = ""
        .BCC = ""
        .Subject = "Konu : Deneme" 'SML.[A2]
        '.Body = ""
        .Attachments.Add MYFILE
[COLOR=darkgreen]        'Burada, 2 nolu hesaba uygun olarak e-mail hazırlanıyor[/COLOR]
        .SendUsingAccount = appAcct
        .Display
        '.Send
    End With

    Set SML = Nothing
    Set appNS = Nothing
    Set appAcct = Nothing
    Set POSTA = Nothing
    Set APP = Nothing
End Sub

Korhan Ayhan · 20 Haziran 2008

Selamlar,

Ferhat bey ilginiz için teşekkür ederim. Yalnız referansım seçili olduğu halde kod aşağıdaki satırda hata verdi.

Kod:

Dim appAcct As Outlook.Account

Compile error:

User-defined type not defined

Ayrıca bilgilendirmek amacıyla resim ekliyorum.

Ferhat Pazarçevirdi · 20 Haziran 2008

Bu sorunu neden kaynaklandığını bilemiyorum. Ben de 2007 Outlook kurulu olduğu için, Microsoft Outlook 12.0 Object Library referansı yüklü ...

Bu değişken tipini, tanımlama satırında; Outllook.Account yerine, Object veya Variant yazarak, geç bağlanmasını sağlayabilirsiniz.

Sizden sonra; ben de Outlook'uma ikinci bir hesap açıp denedim ve her iki hesabı da ayrı ayrı seçerek( 1 ve 2 nolu); sorunsuz mail gönderimi yapıyor.

Haluk · 20 Haziran 2008

Merhaba;

"Accounts" özelliği 2003 versiyonunda desteklendiğini sanmıyorum. Problemin nedeni de bu ....

Bence, CDO yöntemini kullanın.....

.

Korhan Ayhan · 20 Haziran 2008

Selamlar,

Arkadaşlar yanıtlarınız için teşekkür ederim. Sanırım 2003 versiyonunda "Accounts" özelliği Haluk beyinde bahsettiği gibi desteklenmiyor.

Benim aklıma şöyle bir çözüm geldi. Bu makroyu eski haliyle çalıştırdığımda mail penceresi otomatik olarak karşımıza geliyor. Ekrana gelen pencerede 6. mesajımda eklediğim resimdeki menüye kod ile müdahale şansımız nedir. Normal şartlarda pencere karşıma geldiğinde elle bu menüyü açıp seçeneği seçip maili gönderiyorum. Yani sanki mouse ile tıklayıp o menüyü açıp ikinci seçeneği seçmişim gibi bir komutu kod ile yapabilirmiyiz.

Haluk · 20 Haziran 2008

Aşağıdaki linkte, istediğiniz işi yapan bir kod var..... ama neresinde şu anda bulamadım.

Outlook VBA konusunda bulabileceğiniz en iyi site, diyebilirim....

http://www.outlookcode.com/

Buldum, burada ....

http://www.outlookcode.com/codedetail.aspx?id=889

.

Korhan Ayhan · 20 Haziran 2008

Selamlar,

Haluk bey önerdiğiniz sitedeki kodu benim kullandığım koda nasıl adapte edeceğim konusunda yardımcı olabilirmisiniz.

Haluk · 20 Haziran 2008

Korhan bey;

O linkte açıklandığı gibi herşeyden önce, mail editör olarak Word'ün kullanılmıyor olması gerekiyor.

Sizde nasıl, bilemiyorum.

Diğer taraftan, o kod MS Outlook VBA için yazılmış bir fonksiyon. Biraz elini-yüzünü düzeltip MS Excel için uyarlamak gerekiyor. Daha sonra, esas rutin içinden fonksiyonu çağırmak gerekiyor.

Bence siz yine de CDO yöntemini kullanın derim, forumda da zaten örnekleri vardı...

Korhan Ayhan · 20 Haziran 2008

Selamlar,

Haluk bey öneriniz için teşekkür ederim. Ama benim istediğim şekilde olursa çok iyi olacak. Eğer boş bir vaktinizde ilgilenirseniz sevinirim.

Saygılar.

Haluk · 20 Haziran 2008

Korhan bey;

Aşağıda görüldüğü gibi birşeyler yapmaya çalıştım.

Kendiniz bir deneyin, inşallah olur.

Ben Outlook'a bir hesap daha ekledim ve denedim (Office2000), oldu gibi görünüyor....

Aşağıdaki kodlarda da zaten görüldüğü gibi, ilgili fonksiyonu çağırırken e-posta mesajını TTnet isimli hesabımla gönderiyorum. Buradaki kırmızı işaretli yere siz kendinize ait, kullanmak istediğiniz hesap adını yazacaksınız.

Excel VBA'de MS Outlook için ilgili referansı da eklemeyi unutmayın.....

Kod:

Sub Test()
    Dim APP As Outlook.Application
    Dim appNS As Outlook.Namespace
    Dim POSTA As Outlook.MailItem
    
    Set APP = CreateObject("Outlook.Application")
    
    Set appNS = APP.GetNamespace("MAPI")
    appNS.Logon
    
    Set POSTA = APP.CreateItem(olMailItem)
    With POSTA
        .To = "xl.raider@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "Bu bir test mesaj&#305;d&#305;r...."
        .Body = "Test mesaj&#305;nda g&#246;vde....."
         Set_Account "[COLOR=Red][B]TTnet[/B][/COLOR]", POSTA
        .Send
    End With

    Set appNS = Nothing
    Set POSTA = Nothing
    Set APP = Nothing
End Sub
'
Function Set_Account(ByVal AccountName As String, M As Outlook.MailItem) As String
   'Coder : Sue Mosher
   'URL   : http://www.outlookcode.com/codedetail.aspx?id=889
    
    Dim OLI As Outlook.Inspector
    Dim strAccountBtnName As String
    Dim intLoc As Integer
    Const ID_ACCOUNTS = 31224

    Dim CBs As Office.CommandBars
    Dim CBP As Office.CommandBarPopup
    Dim MC As Office.CommandBarControl

    Set OLI = M.GetInspector
    If Not OLI Is Nothing Then
        Set CBs = OLI.CommandBars
        Set CBP = CBs.FindControl(, ID_ACCOUNTS)
        If Not CBP Is Nothing Then
            For Each MC In CBP.Controls
                intLoc = InStr(MC.Caption, " ")
                If intLoc > 0 Then
                    strAccountBtnName = Mid(MC.Caption, intLoc + 1)
                Else
                    strAccountBtnName = MC.Caption
                End If
                If strAccountBtnName = AccountName Then
                    MC.Execute
                    Set_Account = AccountName
                    GoTo Exit_Function
                End If
            Next
        End If
    End If
    Set_Account = ""

Exit_Function:
    Set MC = Nothing
    Set CBP = Nothing
    Set CBs = Nothing
    Set OLI = Nothing
End Function

Korhan Ayhan · 21 Haziran 2008

Selamlar,

Haluk bey maalesef çalışmadı. Emin değilim ama kendime uyarlayamadığımı düşünüyorum. 6. mesajımdaki resimde görünen 2. seçenek "Deneme Mail" şeklinde görünüyor sizin TTnet yazdığınız yere bunu yazıyorum fakat hiçbir değişiklik olmuyor. Normal 1. seçenek seçili olarak mail penceresi açılıyor. Acaba e-posta adresi olarakmı yazmam gerekiyor diyerek "arcadiacost@xxxxxantalya.bim" adresini yazıp denedim fakat yine bir değişiklik olmadı.

Ayrıca kodu adım adım çalıştırdığımda aşağıdaki kısımda döngüye hiç girmiyor.

Kod:

Set CBP = CBs.FindControl(, ID_ACCOUNTS)
If Not CBP Is Nothing Then

Haluk · 21 Haziran 2008

Korhan bey haklısınız, olmuyormuş.... bana da olmuş gibi gelmişti... :mrgreen:

Sağlık olsun....

Haluk · 21 Haziran 2008

Bu arada, anladığım kadarıyla o kodun doğru çalışabilmesi için mesajın önce görüntülenmesi gerekiyor ki sözkonusu menü düğmesi aktif olsun.

Yani, öyle geri plandan bu kodla kullanıcı hesabı değiştirerek mail yollamak mümkün değil.

Korhan Ayhan · 21 Haziran 2008

Selamlar,

Haluk bey ilginiz için çok teşekkür ederim.

accilisse · 7 Mayıs 2011

Benimde böyle bir koda ihtiyacım var.
Yardım edebilirmisiniz?

Outlooktan mail atarken hesaplar kısmını otomatik seçtirmek

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Ferhat Pazarçevirdi

Özel Üye

Korhan Ayhan

Administrator

Ferhat Pazarçevirdi

Özel Üye

Korhan Ayhan

Administrator

Ferhat Pazarçevirdi

Özel Üye

Haluk

Özel Üye

Korhan Ayhan

Administrator

Haluk

Özel Üye

Korhan Ayhan

Administrator

Haluk

Özel Üye

Korhan Ayhan

Administrator

Haluk

Özel Üye

Korhan Ayhan

Administrator

Haluk

Özel Üye

Haluk

Özel Üye

Korhan Ayhan

Administrator

accilisse