Klasördeki dosyaları farklı kişilere mail göndermek

[aydinsertbas]

Merhabalar uzun zamandır foruma üyeyim bu ilk mesajım..
Forumdaki e-mail göndermeyle ilgili başlıkları ve mesajların çoğunu okudum fakat istediğim cevabı göremedim..
Sorum şu: excelde a sütununda ilgili klasördeki dosyanın adı b sütununda göndereceğim kişinin e-mail adresi, c sütununda konu ve d sütununda da kısa bi açıklama e sütununda da cc kısmı olacak.Kodu çalıştırdığımda dosyayı ms outlooka ekleyerek ilgili kişiye gönderecek. Bunu yapan bir kod var mıdır?
Şimdiden teşekkürler.

 

[hamitcan]

Aşağıdaki linkte 20 numaralı mesajda istediğinize benzer bir örnek mevcut.
http://www.excel.web.tr/showthread.php?t=79482&highlight=mail&page=2

 

[aydinsertbas]

Hamit Bey ilginize çok teşekkürler dosya çok işime yarıyacak.

 

[aydinsertbas]

Basit bir soru daha soracağım mümkün müdür bilmiyorum?
Maili gönderirken from kısmıyla gönderebilir miyiz?
Yani mail gönderirken kendi adım çıkıyor mailde bunun yerine from kısmı kodun içinde sabit olarak yazacağım bir isimle gitse.(çalıştığım işyerinde from kısmına yazdığım isimle mail gönderebiliyorum)

 

[hamitcan]

Galiba bu yöntemle dediğinizi yapmak mümkün değil, ama başka bir yöntemle galiba mümkün tabii ki bir takım ayarlamalar yapmak şartıyla. Aşağıda verdiğim linkleri inceleyin, konuyla ilgili detaylı bilgilere ulaşabilirsiniz.
http://www.excel.web.tr/showthread.php?t=32465&highlight=outlook+mail+g%F6nderi
http://www.rondebruin.nl/cdo.htm

 

[aydinsertbas]

İlginiz için çok teşekkürler.

 

[MCAPOWER]

bir klasördeki dosyaların tamamını e-mail gönder

Selamlar,
C:\dosyalar altındaki 1den fazla dosyayı (ad ve uzantıları ne olursa olsun) e-mail ile gönderecek bir macro lazım.

Yardımlarınızı rica ediyorum.
Syg.

Galiba bu yöntemle dediğinizi yapmak mümkün değil, ama başka bir yöntemle galiba mümkün tabii ki bir takım ayarlamalar yapmak şartıyla. Aşağıda verdiğim linkleri inceleyin, konuyla ilgili detaylı bilgilere ulaşabilirsiniz.
http://www.excel.web.tr/showthread.php?t=32465&highlight=outlook+mail+g%F6nderi
http://www.rondebruin.nl/cdo.htm

 

[hamitcan]

Klasörü sıkıştırıp tek bir dosya halinde göndermeyi deneseniz, olmaz mı ?

 

[MCAPOWER]

Klasörü sıkıştırıp tek bir dosya halinde göndermeyi deneseniz, olmaz mı ?

Makroyla sıkıştırmaktan mı bahsediyorsunuz? Klasör altına 5 tane dosya varsa 5ini de gönderme şansım olsa daha çok işime yarar.
Syg.

 

[hamitcan]

Not:Referanslardan Microsoft Outlook XX referansını eklemeyi unutmayın.

Sub BirdenFazlaDosyayiMailAtma()

Dim ds, dc, f, s
Set OutApp = New Outlook.Application
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\")'dosyaların bulunduğu yol
Set dc = f.Files
For Each dosya In dc
Set NewMail = CreateItem(olMailItem)

    With NewMail
    .To = "aaa@aaa.com" ' Bu kısıma mail adresi giriniz.
    .Subject = "deneme" ' Bu kısıma konuyu giriniz.
    .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
    .Attachments.Add "C:\" & dosya.Name'dosyaların bulunduğu yol
    .Send
    End With
Next
End Sub

 

[hukumran1]

Not:Referanslardan Microsoft Outlook XX referansını eklemeyi unutmayın.

Sub BirdenFazlaDosyayiMailAtma()

Dim ds, dc, f, s
Set OutApp = New Outlook.Application
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\")'dosyaların bulunduğu yol
Set dc = f.Files
For Each dosya In dc
Set NewMail = CreateItem(olMailItem)

    With NewMail
    .To = "aaa@aaa.com" ' Bu kısıma mail adresi giriniz.
    .Subject = "deneme" ' Bu kısıma konuyu giriniz.
    .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
    .Attachments.Add "C:\" & dosya.Name'dosyaların bulunduğu yol
    .Send
    End With
Next
End Sub

Klasördeki tüm dosyaları tek mailde nasıl gönderebiliriz.

 

[Korhan Ayhan]

Döngü iç kısma alınırsa birden fazla dosya tek maile eklenmiş olacaktır.

Deneyiniz.

Sub BirdenFazlaDosyayiMailAtma()
    Dim ds, dc, f, s
    
    Set OutApp = New Outlook.Application
    Set ds = CreateObject("Scripting.FileSystemObject")
    Set f = ds.GetFolder("C:\Users\Admin\") 'dosyaların bulunduğu yol
    Set dc = f.Files
    
    Set NewMail = CreateItem(olMailItem)
    
    With NewMail
        .To = "aaa@aaa.com" ' Bu kısıma mail adresi giriniz.
        .Subject = "deneme" ' Bu kısıma konuyu giriniz.
        .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
         On Error Resume Next
         For Each dosya In dc
             .Attachments.Add "C:\Users\Admin\" & dosya.Name 'dosyaların bulunduğu yol
         Next
         On Error GoTo 0
        .Display
        '.Send
    End With
End Sub

 

[hukumran1]

Korhan bey, çok makbule geçti. Tam manasıyla çözmüş bulunduk bu kod sayesinde sorunu.
Teşekkürler.

 

[Seli]

Merhaba arkadaşlar, çok uzun zaman önce yazmışsınız ama aynı kodu denedim bende çalışmadı. Hata alıyorum. Aynı işlemi yapmak istiyordum bende.
Yardımcı olursanız çok sevinirim.

Sub BirdenFazlaDosyayiMailAtma()
Dim ds, dc, f, s

Dim Application
Dim session
Dim OutApp
Dim CreateItem

Set OutApp = New outlook.Application
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021") 'dosyaların bulunduğu yol
Set dc = f.Files

Set Mail = CreateItem(olMailItem)

Dim myDate As Date
'Dim dosya As String

myDate = Date
dosya = "C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021\" & myDate

With NewMail
.To = "aaa@aaa.com" ' Bu kısıma mail adresi giriniz.
.Subject = "deneme" ' Bu kısıma konuyu giriniz.
.Body = Sheets("VERİ AL").Cells(100, 1)
On Error Resume Next
For Each dosya In dc
.Attachments.Add "C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021\" & dosya 'dosyaların bulunduğu yol"
Next
On Error GoTo 0
.Display
'.Send
End With
End Sub

 

[Korhan Ayhan]

Klasör isimlerinde nokta kullanılıyordu sanırım.

Birde kodun çalışması için Vba tarafında References penceresinden "Microsoft Outlook..." ile başlayan referansı aktif hale getiriniz.

 

[Seli]

Sub BirdenFazlaDosyayiMailAtma()
    Dim ds, dc, f, s
    
Set OutApp = New Outlook.Application
Set ds = CreateObject("Scripting.FileSystemObject")
    Set f = ds.GetFolder("C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021") 'dosyaların bulunduğu yol
    Set dc = f.Files
    
 Set NewMail = CreateItem(olMailItem)
    Dim myDate As Date
    'Dim dosya As String
 
    myDate = Date
    dosya = "C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021\" & myDate

    With NewMail
        .To = "aaa@aaa.com" ' Bu kısıma mail adresi giriniz.
        .Subject = "deneme" ' Bu kısıma konuyu giriniz.
        .Body = Sheets("VERİ AL").Cells(100, 1)
         On Error Resume Next
         For Each dosya In dc
             .Attachments.Add "C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021\" & dosya 'dosyaların bulunduğu yol"
         Next
         On Error GoTo 0
        .Display
        '.Send
    End With
End Sub

Teşekkür ederim hata düzeldi, fakat şimdi de eklentileri eklemiyor. Klasörün içinde üç adet excel var hiçbirini almıyor. Neden olabilir sizde? Çok teşekkürler..

 

[Korhan Ayhan]

Bu satırı silin ki nerede hata veriyor takip edebilin.

On Error Resume Next

 

[Seli]

Sub mailsonnn()
Dim myDate As Date
    myDate = Date
    'selis = "Kapasite" & myDate
    
    
    Set ds = CreateObject("Scripting.FileSystemObject")
    kls = "C:\Users\selcanusta\Desktop\KAPASİTE ANALİZİ\01.02.2021\24.02.2021\"   '24.02.2021 dosyasının içinde iki excel ve bir power bi raporu var bunları boş alıyor
    If Dir(kls) = "" Then MsgBox "Klasor yok": Exit Sub
    Set dc = ds.GetFolder(kls).Files 'dosyaların bulunduğu yol

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .Subject = myDate & " " & "Kafes Kapasite Analizi"
        .HTMLBody = Sheets("Mail Gönder").Range("A1:A5").Value & vbNewLine    'BURAYI YAZMIYOR
        
        
            For Each dosya In dc
             .Attachments.Add dosya.Path 'dosyaların bulunduğu yol"
            Next
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Teşekkür ederim, düzenledim. Şuan çalışıyor ama body kısmını yazmıyor. Hücre içindeki değer mavi ve fontu farklı onu da algılamadı. Neden olabilir? Şimdiden teşekkürler..

 

[Korhan Ayhan]

Linki inceleyiniz.

mail gönderirken alt satıra da yazdırmak

Merhaba ; excelden mail gönderirken , fatura adedinden sonraki bilgileri bir alt satırda nasıl gösterebilirim ? .Display .htmlbody = "Merhaba," & Cells(i, "D") & " " & "Fatura Adedi:" & " " & Cells(i, "E") & " ** " & "Fatura Toplamı :" & " " & Cells(i, "F") & Cells(i, "G").Value &...

www.excel.web.tr