• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

S

Sinan2618

Katılım
17 Ağustos 2016
Mesajlar
118
Excel Vers. ve Dili
2013 Türkçe
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?
 
Merhaba,

Bu konu forumda işlendi. Lütfen arama yapınız.
 
Örnek dosya ekleyiniz.
 
Korhan Ayhan' Alıntı:
Örnek dosya ekleyiniz.
Genişletmek için tıkla ...


Ö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.
 

Ekli dosyalar

Deneyiniz.

Kod: 
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
 
metince54' Alıntı:
hocam bunu kod görüntüleye yapıştırıp oradan mı çalıştırma yapacaz
Genişletmek için tıkla ...

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.
 
ö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
 
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.

Kod: 
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
 
Son düzenleme:
Merhaba aynı .send hatasını bende alıyorum
 
Uguladığınız dosyanızı paylaşrısanız hataya neyin sebep olduğunu tespit edebiliriz.
 
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.
 
Bahsi geçen hücrede dosyanın tam yolu ve uzantısı olmalıdır.

Örnek;

C:\Desktop\Günlük_Rapor.xlsx
 
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
 
ayse1989' Alıntı:
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
Genişletmek için tıkla ...

Ö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.
 
Şö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
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst