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

A

aydinsertbas

Katılım
5 Temmuz 2009
Mesajlar
9
Excel Vers. ve Dili
2007,ingilizce
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.
 
A

aydinsertbas

Katılım
5 Temmuz 2009
Mesajlar
9
Excel Vers. ve Dili
2007,ingilizce
Hamit Bey ilginize çok teşekkürler dosya çok işime yarıyacak.
 
Son düzenleme:
A

aydinsertbas

Katılım
5 Temmuz 2009
Mesajlar
9
Excel Vers. ve Dili
2007,ingilizce
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)
 
M

MCAPOWER

Katılım
26 Ocak 2009
Mesajlar
21
Excel Vers. ve Dili
uSA
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.


hamitcan' Alıntı:
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
Genişletmek için tıkla ...
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Klasörü sıkıştırıp tek bir dosya halinde göndermeyi deneseniz, olmaz mı ?
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Not:Referanslardan Microsoft Outlook XX referansını eklemeyi unutmayın.

Kod: 
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
 
H

hukumran1

Katılım
8 Temmuz 2014
Mesajlar
120
Excel Vers. ve Dili
Office 2016 Türkçe
hamitcan' Alıntı:
Not:Referanslardan Microsoft Outlook XX referansını eklemeyi unutmayın.

Kod: 
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
Genişletmek için tıkla ...
Klasördeki tüm dosyaları tek mailde nasıl gönderebiliriz.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Döngü iç kısma alınırsa birden fazla dosya tek maile eklenmiş olacaktır.

Deneyiniz.

Kod: 
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
 
H

hukumran1

Katılım
8 Temmuz 2014
Mesajlar
120
Excel Vers. ve Dili
Office 2016 Türkçe
Korhan bey, çok makbule geçti. Tam manasıyla çözmüş bulunduk bu kod sayesinde sorunu.
Teşekkürler.
 
S

Seli

Katılım
22 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
Ofis 360 Türkçe
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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.
 
S

Seli

Katılım
22 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
Ofis 360 Türkçe
Kod: 
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu satırı silin ki nerede hata veriyor takip edebilin.

On Error Resume Next
 
S

Seli

Katılım
22 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
Ofis 360 Türkçe
Kod: 
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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 www.excel.web.tr
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst