Toplu mail gönderiminde farklı adreslere farklı dosya eki göndermek

[Sinan2618]

Merhaba,

Benim mail olarak göndermem gereken 550'ye yakın excel dosyam var amacım sabit bir önyazı ile cc'ye kendi mailimi yazarak bcc şekilde tüm dosyaları tanımladığım farklı mail adresilerine göndermek. örneğin dosya1'i yanına yazacağım maile dosya2'yi yine sadece onun yanına yazacağım maile göndermek istiyorum.

Önyazım ve mail imzam sabit olacak sadece dosyaları doğru ekleyecek bir kod var mıdır?

 

[Korhan Ayhan]

Merhaba,

Bu konu forumda işlendi. Lütfen arama yapınız.

 

[Sinan2618]

Merhaba,

Bu konu forumda işlendi. Lütfen arama yapınız.

Korhan bey merhaba,

oldukça fazla aradım ancak bulamadım bulduklarımda ek dosya sabit 1 adet olup çoklu mail adresine gönderim seçeneği vardı. Çoklu mail'e farklı dosya eki göndermeyi bulamadım

 

[Korhan Ayhan]

Örnek dosya ekleyiniz.

 

[Sinan2618]

Örnek dosya ekleyiniz.

Özyazım sabit olacak ister excel içerisine isterse koda ekleyebiliriz. tek istediğim benim eşleştirmiş olduğum mail adresine eşleştirdiğim dosyanın gönderilmesi. ayrı ayrı maillere göndermem gereken 500'e yakın dosyam var desteğinizi rica ederim.

 

[Korhan Ayhan]

Deneyiniz.

Sub Toplu_Mail_Yolla()
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim S1 As Worksheet, Mesaj As String, Imza As String, Signature As String
    Dim Cevap As Integer, Son As Long, Veri As Range
    
    Mesaj = "Mail gönderim işlemini onaylıyor musunuz?"
    Cevap = MsgBox(Mesaj, vbOKCancel + vbQuestion)
    If Cevap = vbOK Then
        Yol = Environ("appdata") & "\Microsoft\Signatures\"
        Imza = Dir(Yol & "*.htm")
        
        If Imza <> "" Then
            Signature = Get_Signature(Yol & Imza)
        Else
            Signature = ""
        End If
        
        Application.ScreenUpdating = False
                
        Set S1 = Sheets("Sayfa1")
        Set Uygulama = CreateObject("Outlook.Application")
        
        Son = S1.Cells(Rows.Count, 1).End(3).Row
        
        For Each Veri In S1.Range("A2:A" & Son)
            If S1.Cells(Veri.Row, "A") <> "" And S1.Cells(Veri.Row, "B") <> "" And S1.Cells(Veri.Row, "C") <> "" Then
                Set Yeni_Mail = Uygulama.CreateItem(0)
                With Yeni_Mail
                    .To = S1.Cells(Veri.Row, "B").Value
                    .Cc = "Kendi Mail Adresinizi Yazınız"
                    .Subject = "Mail Konusunu Yazınız"
                    .HTMLBody = S1.Cells(Veri.Row, "A").Value & "<br>" & Signature
                    .Attachments.Add S1.Cells(Veri.Row, "C").Value
                    '.Display
                    .Send
                    Say = Say + 1
                End With
                Set Yeni_Mail = Nothing
            End If
        Next
        
        Set Uygulama = Nothing
        
        Application.ScreenUpdating = True
        
        MsgBox "İşleminiz tamamlanmıştır." & vbNewLine & "Toplam gönderilen mail sayısı ; " & Say
    End If
End Sub

Function Get_Signature(ByVal Imza_Dosyasi As String) As String
    Dim Dosya_Sistemi As Object
    Dim Dosya As Object
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
    Set Dosya = Dosya_Sistemi.GetFile(Imza_Dosyasi).OpenAsTextStream(1, -2)
    Get_Signature = Dosya.Readall
    Dosya.Close
End Function

 

[Sinan2618]

Hocam Ellerinize sağlık Tam aradığım şey oldu

 

[metince54]

Hocam Ellerinize sağlık Tam aradığım şey oldu

hocam bunu kod görüntüleye yapıştırıp oradan mı çalıştırma yapacaz

 

[Sinan2618]

hocam bunu kod görüntüleye yapıştırıp oradan mı çalıştırma yapacaz

Kod görüntüle dedikten sonra insert modulü deyip kodu yapıştırın kaydettikten sonra excelde Ekle > Şekiller kısmında kare veya yuvarlanmış şekil ekleyin içine gönder butonu vs yazıp sağ tıkladıktan sonra makro ata ile bu kodu tanımlayın butona tıklayınca işlemi yapıyor. Eğer takılırsanız örnek dosyada oluşturup eklerim.

 

[u.L.a.s]

örnek excel dosyasını bizlerinde göreceği şekilde buraya yükleyebilir misiniz. bu kod nasıl bir şablona göre hazırlandı görmek incelemek istiyorum. Teşekkür ederim

 

[enesyildiz]

hocam konuyu tekrar aktif edeyim.

bilgleri mail adresini ve dosya yollarını giriyorum .. Alltaki .send kısmında hata veriyor. uyarı penceresinde outlook bir veya birden fazla adı tanımıyor yazıyor.

For Each Veri In S1.Range("A2:A" & Son)

            If S1.Cells(Veri.Row, "A") <> "" And S1.Cells(Veri.Row, "B") <> "" And S1.Cells(Veri.Row, "C") <> "" Then

                Set Yeni_Mail = Uygulama.CreateItem(0)

                With Yeni_Mail

                    .To = S1.Cells(Veri.Row, "B").Value

                    .Cc = "Kendi Mail Adresinizi Yazınız"

                    .Subject = "Mail Konusunu Yazınız"

                    .HTMLBody = S1.Cells(Veri.Row, "A").Value & "<br>" & Signature

                    .Attachments.Add S1.Cells(Veri.Row, "C").Value

                    '.Display

                    .Send

                    Say = Say + 1

                End With

 

[ugurv]

Merhaba aynı .send hatasını bende alıyorum

 

[Korhan Ayhan]

Uguladığınız dosyanızı paylaşrısanız hataya neyin sebep olduğunu tespit edebiliriz.

 

[Seli]

Merhaba, .Attachments.Add S1.Cells(Veri.Row, 5).Value bu kısım bende hata veriyor hocam E sütununa excelin ismini yazdım ornegın Ankara şeklinde format farklı mı acaba? Teşekkür ederim.

 

[Korhan Ayhan]

Bahsi geçen hücrede dosyanın tam yolu ve uzantısı olmalıdır.

Örnek;

C:\Desktop\Günlük_Rapor.xlsx

 

[Seli]

Çok teşekkürler hocam oldu şimdi.

 

[ayse1989]

Hocam bana da gerekli böyle bir kod standart bir mail ile 250 ye yakın farklı excel dosyalarını ilgili kişilere göndereceğim ama benim yukarda yazdiginiz kodu excelle uygulayacak kadar Excel bilgim yok ben bu iş için 2 gün uğraşıyorum neredeyse bana da yardim eder misiniz

 

[RBozkurt]

Hocam bana da gerekli böyle bir kod standart bir mail ile 250 ye yakın farklı excel dosyalarını ilgili kişilere göndereceğim ama benim yukarda yazdiginiz kodu excelle uygulayacak kadar Excel bilgim yok ben bu iş için 2 gün uğraşıyorum neredeyse bana da yardim eder misiniz

Örneğin masaüstündeki X klasörü içinde 250 tane farklı excel dosyası var.
Elinizde de 250 kişilik mail listesi var.
Hangi mail adresine; hangi excel dosyasının gideceğini nasıl belirliyorsunuz? yada belirleyebileceksiniz? Eşleşme mantığını kuramadım.

mail adresi test@1.com ; dosya adıda test@1.com.xlsx bu eşleşme örneği gibi.

 

[ayse1989]

Şöyle anlatayım hocam 250 tane magzam var ve hergun envanter yapıp sisteme düşüyor her bir magazinin envanterini sistemden çekip excele aktarıp belirli düzenlemeler ve pivot tablo yaparak magazanin ismini verip örneğin 0066 yada 2512 falan kaydediyorum mağazaların ismi rakamlardan oluşuyor hepsi dört haneli kaydediyorum düzenliyorum ve bu hazırladığım dosyaları ilgili mağazalara yapılan envanterin sonucu diye güzel bir yazıyla standart tek tek 250 mağazaya gönderiyorum farklı kişiler anlatabildim mi bilmiyorum ama sonuç bu

 

[ayse1989]

Ve bu işlemi hergun yapıyorum ve yeni sistemde bir mağaza bir günde 3 tane parça parça envanter yapıyor yani 250 çarpı 3 toplam 750 mail