[simurg83]

Merhabalar

Ekteki gibi mail makrosunu sizlerin yardımıyla düzenli bir hale getirebilmiştim , acaba bu makroyu maili gönderirken masa üstünde bulunan birden fazla ekide gönderecek bir iyileştirme mümkün mü ? Mümkünse excel bilgim çok iyi olmadığı için yerleşmesi gereken yeri ve yazılması gereken kodu belirtmeniz mümkün müdür

[erseldemirel2]

Aşağıdaki örnek kod deneme yolundaki deneme.txt ekler.

Kod: Tümünü seç

Sub send_email_complete()
Dim outlookApp As Outlook.Application
Dim myMail As Outlook.MailItem
Dim source_file, to_emails, cc_emails As String
Dim i, j As Integer

Set outlookApp = New Outlook.Application
Set myMail = outlookApp.CreateItem(olMailItem)


    to_emails = "deneme"
    cc_emails = "deneme2"




    source_file = "D:\DENEME\" & "deneme.txt"
    myMail.Attachments.Add source_file


ThisWorkbook.Save


myMail.CC = cc_emails
myMail.To = to_emails
myMail.Subject = "Files for Everyone"
myMail.Body = "Hi Everyone," & vbNewLine & "Test" & vbNewLine & "Thanks"

myMail.Display


End Sub

[simurg83]

Cevabın için çok teşekkür ama ben maille hesap ayrıntılarını excel yada pdf olarak gönderebiliyorum bu formatta ekle şansım yok mu birde makromu ekledim bu makroda nereye yerleştirmem gerekir

[simurg83]

Bu konuda yardımcı olabilecek birilerinin desteğine ihtiyacım var

[Ali ÖZ]

Merhaba,
Talebiniz net olarak anlaşılmıyor.
Maile dosya eklemeyi soruyorsunuz gönderdiğiniz dosyadaki kodlar ise mail gövdesine alan ekleme kodları.
Tam olarak istediğiniz nedir ?

[simurg83]

Sayın Ali bey
İyi aķşamlar zip olarak eklediğim makro benim smtp sunucyla mail göndermemi sağlayan şablonum bu kodların içine şablonu bozmadan sizlerin yardımıyla ek bir kod yazarak masa üstümde hedef göstereceğim yerden mailimle birlikte aynı anda excel ve pdf dosyalarıda ek olarak(attachment) göndermem mümkümse yardımınızı rica ediyorum

[Ali ÖZ]

Merhaba,
Sn. erseldemirel2 in kodlarını kullnabilirsiniz.

[simurg83]

Sayın Ali bey

Bir şekilde kodu doğru kullanmayı başardım ,ekleri gönderebiliyorum Ersin beye size teşekkür ederim fakat atladığım bir durum olmuş. Bazen dosya göndermeme ihtiyacım olmadan maili göndermem gerekiyor haliyle hedef klasörlerde ki dosyalar ilgisiz kişiye gitmesin diye siliyorum ve bu şekilde dosya olmadan maili göndermek istediğimde görüntüde ki hatayı veriyor bu sebeple ilgili kodu dosya olmasa da gönder şeklinde nasıl yazabiliriz

[erseldemirel2]

Aşağıdaki kodu deneyenilirsin. DENEME yolunu kontrol ediyor. Hiç dosya bulamassa msgbox veriyor.

Kod: Tümünü seç

...
...
...
strpath = "D:\DENEME\"
source_file = "D:\DENEME\" & "DENEME.TXT"
If Dir(strpath & "*.*") = "" Then
MsgBox "Dosya Yok"
Else
myMail.Attachments.Add source_file
End If
...
...
...

[simurg83]

Sayın Ersin bey

Görüntüde ki dizilimle ek göndermeyi yapabildim acaba bu dizilimde dosya hedefleri boşsa yine de maili gönderi nasıl yapabilirim

Sizin belirttiğiniz kodlarla düzenlemeye çalıştım kod bilgim hiç olmadığı olmadığı için yerleştiremedim yardımcı olmanız mümkün mü

[simurg83]

Sayın Ersin bey

Görüntüde ki dizilimle ek göndermeyi yapabildim acaba bu dizilimde dosya hedefleri boşsa yine de maili gönderi nasıl yapabilirim

Sizin belirttiğiniz kodlarla düzenlemeye çalıştım kod bilgim hiç olmadığı olmadığı için yerleştiremedim yardımcı olmanız mümkün mü

[erseldemirel2]

dosyanızı eklerseniz bir bakayım bende

[simurg83]

Günaydın

Desteğiniz için teşekkür ederim ektedir

[erseldemirel2]

Aşağıdakini deneyin

Kod: Tümünü seç

...
...
strpath = "C:\Users\HuseyinDemir\Desktop\"
If Dir(strpath & "*.*") = "" Then
ek1 = ""
ek2 = ""
ek3 = ""
Else
ek1 = "C:\Users\HuseyinDemir\Desktop\hesap ayrıntısı\hesap ayrıntısı.xls"
ek2 = "C:\Users\HuseyinDemir\Desktop\fatura\fatura.pdf"
ek3 = "C:\Users\HuseyinDemir\Desktop\mail order\ödeme formu.doc"
End If



With iMsg
    .To = Worksheets("sayfa2").Cells(2, 2).Value
    .CC = Worksheets("Sayfa2").Cells(3, 2).Value
    .From = "Hüseyin Demir <hdemir@gmail.com>"
    .Bcc = "Hüseyin Demir <hdemir@gmail.com>"
    .Subject = Worksheets("Sayfa2").Cells(1, 1).Value + " - " + Worksheets("Sayfa2").Cells(5, 1).Value
    .HTMLBody = StrBody & RangetoHTML(rng) & StrBody1
    .AddAttachment ek1
    .AddAttachment ek2
    .AddAttachment ek3
   
    Set .Configuration = iConf
    .Send
End With
...
...
...

[simurg83]

Kusuruma bakma lütfen zamanını alıyorum konu da uzadıkça uzuyor fakat denedim sadece hesap ayrıntısı klasöründe dosya vardı diğer ikisinde yoktu maili gönderdi ama görüntü de ki 3 klasör için .bin uzantılı ekler verdi excel olan hesap ayrıntısı klasöründe ki dosyayı eklemedi

[erseldemirel2]

3 ayrı klasör varmış. ona bakmamıştım.

şunu deneyin biraz uzun ama kısaltılabilir

Kod: Tümünü seç

...
...
...
strpath1 = "C:\Users\HuseyinDemir\Desktop\hesap ayrıntısı\"
strpath2 = "C:\Users\HuseyinDemir\Desktop\fatura\"
strpath3 = "C:\Users\HuseyinDemir\Desktop\mail order\"

If Dir(strpath1 & "*.*") = "" Then
ek1 = "yok"
Else
ek1 = "C:\Users\HuseyinDemir\Desktop\hesap ayrıntısı\hesap ayrıntısı.xls"
End If

If Dir(strpath2 & "*.*") = "" Then
ek2 = "yok"
Else
ek2 = "C:\Users\HuseyinDemir\Desktop\fatura\fatura.pdf"
End If

If Dir(strpath3 & "*.*") = "" Then
ek3 = "yok"
Else
ek3 = "C:\Users\HuseyinDemir\Desktop\mail order\ödeme formu.doc"
End If


With iMsg
    .To = Worksheets("sayfa2").Cells(2, 2).Value
    .CC = Worksheets("Sayfa2").Cells(3, 2).Value
    .From = "Hüseyin Demir <hdemir@gmail.com>"
    .Bcc = "Hüseyin Demir <hdemir@gmail.com>"
    .Subject = Worksheets("Sayfa2").Cells(1, 1).Value + " - " + Worksheets("Sayfa2").Cells(5, 1).Value
    .HTMLBody = StrBody & RangetoHTML(rng) & StrBody1
    If Not ek1 = "yok" Then
    .AddAttachment ek1
    End If
        If Not ek2 = "yok" Then
    .AddAttachment ek2
    End If
        If Not ek3 = "yok" Then
    .AddAttachment ek3
    End If
   
    Set .Configuration = iConf
    .Send
End With
...
...
...

[simurg83]

Sayın Ersel bey

Eline koluna sağlık çok teşekkür ederim cidden çok yardımcı olacak bir paylaşım

[erseldemirel2]

Siz saolun kolay gelsin