Makro kodları ile Outlook iletisine birden fazla dosya eklemek

[antonio]

Arkadaşlar makro kodları kullanarak Outlook ile mesaj gönderme kodlarını incelediğimde nedense sadece bir dosya ekleme örnekleri mevcut. Oysa bu birden fazla dosya da olabilir. Ben şöyle bir çalışmak yaptım, fakat sorun var.

Sub mail_gonder()
Dim OutApp As Object, OutMail As Object
Dim ek1 As String, ek2 As String, ek3 As String, ekler As String

On Error Resume Next

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

ek1 = Application.GetOpenFilename
Range("b5") = ek1
ek2 = Application.GetOpenFilename
Range("d5") = ek2
ek3 = Application.GetOpenFilename
Range("f5") = ek3
ekler = ek1 & ";" & ek2 & ";" & ek3
With OutMail
.Display
.To = Range("B1").Text
.CC = Range("B2").Text
.BCC = Range("B3").Text
.Subject = Range("B4").Text
.Body = Range("B6").Text
.Attachments.Add ekler

End With

End Sub

Çalışıyor ama ekleri ilave etmiyor.
Farklı bir çözümü var mıdır?
Önceden teşekkürler

 

[hamitcan]

Aşağıdaki şekilde deneyin.

Sub BirdenFazlaEk_gonder()
Dim OutApp As Object, OutMail As Object
    Dim myFileList(1) As String
'On Error Resume Next
     myFileList(0) = "C:\dene.xls"
     myFileList(1) = "C:\dene2.xls"

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "aaa@aaa.com"
        .CC = Range("B2").Text
        .BCC = Range("B3").Text
        .Subject = Range("B4").Text
        .Body = Range("B6").Text
        For i = 0 To UBound(myFileList)
        .Attachments.Add myFileList(i)
        Next
        .Display
    End With
End Sub

Kaynak:
http://www.mrexcel.com/forum/excel-...ns-send-multiple-attachments-via-outlook.html
http://stackoverflow.com/questions/9503109/email-2-or-more-excel-workbooks-with-vba

 

[antonio]

hamitcan çok teşekkür ederim.

Excel sayfasında ki hücrelere ekleri yapıştırdığım zaman sorun oluşmuyor.
Ancak UserForm kullanırken ekleri textbox lara yapıştırarak aynı işlemi yaptığım zaman hata veriyor.
Örnek kodlar 4 nolu mesajımdadır.

 

[antonio]

hamitcan bir sorun oluştu. Dosya yolunu aşağıda ki textboxlara önceden yazıyorum ve sonra kodu şöyle düzenliyorum.

Dim ekler(1) As String, i As Integer
ekler(0) = TextBox19.Value
ekler(1) = TextBox20.Value
With CreateObject("Outlook.Application").CreateItem(0)
    .Display
    .to = TextBox7.Text
    .Subject = TextBox32.Text
    .Body = TextBox31.Text
For i = LBound(ekler) To UBound(ekler)
    .Attachments.Add = ekler(i)
Next i
End With

şeklinde yazdığım kodları çalıştırdığım zaman ekleri ilave etmiyor. dosya yolunu textbox a sihirbaz yardımıyla yazdırmış olduğum için hata söz konusu olamaz.
Sebebi ne olabilir acaba?

 

[hamitcan]

Dosyanızı ekleyin.

 

[antonio]

Sayın hamitcan,
MEBBİS Sayfasında ayrıntılı olarak kurum bilgileri yer almaktadır.
ARA Sayfası, form oluşturulmadan önce arama bilgilerini süzmek için hazırlanmış, daha sonra sayfaya arama ve e-posta işlevini gören bir form ilave edilmiştir.
formun add. yazan textbox larına tıklayınca sihirbaz açılmakta ve dosya seçilmektedir. ADD yazısına çift tıklayınca da, dosya silinmektedir.
gönder butonuna basıldığı zaman gönderme işlevi oluşur. (ancak bu kodlamayı, eklerin gönderilmesinin hata vermesi yüzünden sadece 1.butona uyguladım).
İlginiz için şimdiden teşekkür eder, ilgi duyan arkadaşların geliştirip burada her kesin yararına sunacağına inancım ve saygılarımla.

 

[hamitcan]

Bu şekilde çalıştı.

Private Sub CommandButton10_Click()
Dim OutApp As Object, OutMail As Object

    Dim ek(1) As String

     ek(0) = TextBox19.Text
     ek(1) = TextBox20.Text

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "aaa@aaa.com"
        .CC = Range("B2").Text
        .BCC = Range("B3").Text
        .Subject = Range("B4").Text
        .Body = Range("B6").Text
        For i = 0 To UBound(ek)
        .Attachments.Add ek(i)
        Next
        .Display
    End With
End Sub

 

[antonio]

Bu şekilde çalıştı.

Private Sub CommandButton10_Click()
Dim OutApp As Object, OutMail As Object

    Dim ek(1) As String

     ek(0) = TextBox19.Text
     ek(1) = TextBox20.Text

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "aaa@aaa.com"
        .CC = Range("B2").Text
        .BCC = Range("B3").Text
        .Subject = Range("B4").Text
        .Body = Range("B6").Text
        For i = 0 To UBound(ek)
        .Attachments.Add ek(i)
        Next
        .Display
    End With
End Sub

Maalesef sadece iki ek ilave etmek isterken bile sorun çıkardı bende.
Zaman ayırıp ilgilendiğiniz için çok teşekkür ederim.

 

[hamitcan]

Microsoft Outlook 12.0 Object Library referansı seçili mi ?

 

[antonio]

Evet seçili.