[Yardım]  Dosya eklemeli çoklu mail

Excel ile MS Outlook, Outlook Express, Gmail vb. programlar ile mail işlemleri hakkındaki bölüm.

Dosya eklemeli çoklu mail

İleti#1)  batuk9 » 04 Oca 2018 17:30

Arkadaşlar ekteki dosyamda yapmam gereken B sütununda yazan mail adreslerine kendi sütunundaki konu ve açıklamaları yazarak, E sütunundaki dosya yolundan .pdf .html .jpg gibi dosyaları maile ekleyerek göndermesi. Kodlarla bir şeyler yapmaya çalıştım kafam iyice karıştı. Yardımlarınızı bekliyorum.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
batuk9
Siteye Alışmış
 
Adı Soyadı:mehmet batuk
Kayıt: 01 Kas 2010 14:38
İleti: 367
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adana

Cevap: Dosya eklemeli çoklu mail

İleti#2)  batuk9 » 05 Oca 2018 00:41

Arkadaşlar yüzdük kuyruğuna geldik. Kodda yardım istediğim nokta E sütununda dosya yolu belirttiğim yerden dosyaları almak. Denemeler yaptım olmadı. Yardım lütfen.

Kod: Tümünü seç
Private Sub CommandButton1_Click()
                   
    Dim OutApp, strbody
    Dim Dosya
    Dim Dosya2
    Dim dosyayolu As String
    Dim mm As Worksheet
    Set mm = Sheets("Sayfa1")
    aa = mm.[b65536].End(3).Row
    For a = 2 To aa
   
   
   
   
    dosyayolu = "D:\urunler\" 'mm.Range("e" & a)   'Resimleriniz Dosya Yolu
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
        'strbody = "Mesajınız" & vbNewLine & vbNewLine & _
         '   "1.Satır" & vbNewLine & _
          '  "2.Satır" & vbNewLine & _
           ' "3.Satır" & vbNewLine & _
            '"4.Satır"
           
                On Error Resume Next
               
                    With OutMail
                   
                        .To = mm.Range("b" & a)
                        .CC = ""
                        .BCC = ""
                        .Subject = mm.Range("c" & a) ' Mail konu
                        '.Body = strbody
                        .Body = mm.Range("d" & a)
                       
                            'dosyayolu = dosyayolu & TextBox1 & "\"
                           
                            ChDrive (Left(dosyayolu, 1))
                            ChDir (dosyayolu)
                            Dosya = Dir("*.jpg")
                            Dosya2 = Dir("*.html")
                                While Dosya <> ""
                                    .Attachments.Add dosyayolu & Dosya 'ekleri Alıyor
                                    Dosya = Dir
                                Wend
                                    .Attachments.Add dosyayolu & Dosya2 'ekleri Alıyor
                                    Dosya2 = Dir
                        .Send
                       
                    End With
               
                On Error GoTo 0
               
            Set OutMail = Nothing
           
        Set OutApp = Nothing
       
    Set oApp = Nothing
    Next
   
End Sub



Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
batuk9
Siteye Alışmış
 
Adı Soyadı:mehmet batuk
Kayıt: 01 Kas 2010 14:38
İleti: 367
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adana

Cevap: Dosya eklemeli çoklu mail

İleti#3)  batuk9 » 07 Oca 2018 00:55

Arkadaşlar bir el atın çözelim şu işi artık. Aşağıda ki kodda strFile = Dir("D:\urunler\*") kısmında ki dosya yolunu e2 den başlayıp maile eklemek istiyorum. Nasıl bir yol izlemeliyim. mm.Range("e" & a) şeklinde yapınca dosyaları maile eklemiyor.

Kod: Tümünü seç
Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim strFile As String
   
    Dim mm As Worksheet
    Set mm = Sheets("Sayfa1")
    aa = mm.[b65536].End(3).Row
    For a = 2 To aa
   

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'strbody = "Hi there" & vbNewLine & vbNewLine & _
              "See attached" & vbNewLine


    On Error Resume Next
    With OutMail
        .To = mm.Range("b" & a)      'Email Address (can be a cell reference)
        .CC = ""
        .BCC = ""
        .Subject = mm.Range("c" & a)
        .Body = mm.Range("d" & a)
        strFile = Dir("D:\urunler\*")  'location of files to send
        Do While Len(strFile) > 0
            .Attachments.Add ("D:\urunler\" & strFile) 'insert your file path here too no Asterisk *
            strFile = Dir
        Loop
        .Send                    'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    Next
End Sub

Kullanıcı avatarı
batuk9
Siteye Alışmış
 
Adı Soyadı:mehmet batuk
Kayıt: 01 Kas 2010 14:38
İleti: 367
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adana

Cevap: Dosya eklemeli çoklu mail

İleti#4)  Tarkan VURAL » 09 Oca 2018 21:44

Yazdığınız koda bakalım.
Kod: Tümünü seç
dosyayolu = mm.Range("e" & a)


Excel "e" & a hücresindeki veriye bakalım.
C:\Users\MSB\Desktop\mail\a


Şimdi dosya yolu ne oldu ?
Kod: Tümünü seç
dosyayolu = "C:\Users\MSB\Desktop\mail\a"

... şeklinde oluştu.

Eğer dosya yolunda belirttiğiniz en sondaki a adında uzantısız bir dosyanız varsa mail eki olarak oluşur. Yok ise sistem bunu yorumlayamaz ve bir şey ekleyemez. Dosyanızı Excel hücresinde tanımlarken ya uzantısı ile birlikte ifade edin; ya da bu bir dosya değil klasör yolu ise aşağıdaki yöntemle deneyin.
Kod: Tümünü seç
.Body = mm.Range("d" & a)

klasoryolu = mm.Range("e" & a)
set evn = createobject("scripting.filesystemobject")
set klasor = evn.getfolder(klasoryolu)
for each dosya in klasor.files
.Attachments.Add dosya.path
next

.Send
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26822
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Dosya eklemeli çoklu mail

İleti#5)  batuk9 » 09 Oca 2018 23:41

Çok teşekkür ederim Tarkan Bey. Dosya mı ekliyorum ihtiyacı olan arkadaşlar için. Kolay gelsin.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
batuk9
Siteye Alışmış
 
Adı Soyadı:mehmet batuk
Kayıt: 01 Kas 2010 14:38
İleti: 367
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adana

Cevap: Dosya eklemeli çoklu mail

İleti#6)  Tarkan VURAL » 10 Oca 2018 02:18

Elinize sağlık. --)(
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26822
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Dosya eklemeli çoklu mail

İleti#7)  fuatckmk » 17 Oca 2018 14:22

Tarkan VURAL yazdı:Elinize sağlık. --)(



Tarkan bey merhaba,

benzer bir konu bende de mevcut aynı kodu kullanıyorum fakat şöyle bir durum söz konusu;

Dosya yolunu E kolonundan alıyor yani (x,5) direkt olarak dosyanın uzantısını yapıştırıyorum. Şöyle değiştirmek mümkün mü?

Klasör adına göre ilgili klasörün içerisindeki tüm excel dosyalarını alsın. ( Mesela klasör isimleri hep sabit olacak içerisindeki veriler değişecek "Ali" klasör adına girip içindekileri maile ekleyecek) gibi

Dim dosya As String

Kod: Tümünü seç
Sub MAIL_GONDER()
    Dim Outlook_App As Object
    Dim Outlook_Mail As Object

    Dim S1 As Worksheet, X As Long
    Dim dosya As String
    Set Outlook_App = CreateObject("Outlook.Application")
    Set S1 = Sheets("Sayfa1")
   
    For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
        If S1.Cells(X, 4) = "" Then
            Set Outlook_Mail = Outlook_App.CreateItem(0)
            With Outlook_Mail
            .display
                .To = S1.Cells(X, 3)
                .CC = S1.Cells(X, 6)
                .Subject = S1.Cells(X, 2)
                .HTMLBody = S1.Cells(X, 1) & .HTMLBody
                dosya = S1.Cells(X, 5).Value
                .Attachments.Add dosya
                .Save
                .send
                S1.Cells(X, 4) = "Gönderildi."
            End With
        End If
    Next
   
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
Kullanıcı avatarı
fuatckmk
Yeni Başlamış
 
Kayıt: 17 Oca 2018 14:14
Meslek: Finans
Yaş: 25
İleti: 24
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli

Cevap: Dosya eklemeli çoklu mail

İleti#8)  Tarkan VURAL » 20 Oca 2018 20:49

Merhaba,
Kod: Tümünü seç
dosya = S1.Cells(X, 5).Value
.Attachments.Add dosya


Bu kod parçası ile S1 sayfasının X,5 kesişme adresindeki dosyayı alıp mail içerisine ekliyor. Bu alana bir klasör adı yazarsanız kodlar şu şekilde revize edilebilir:

Kod: Tümünü seç
dosya = S1.Cells(X, 5).Value
for each altdosyalar in createobject("scripting.filesystemobject").getfolder(dosya).files
.Attachments.Add altdosyalar.path
next


Denemedim ama çalışacağını düşünüyorum.
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26822
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

Cevap: Cevap: Dosya eklemeli çoklu mail

İleti#9)  ufuk.korkmaz » 07 Kas 2018 12:34

Tarkan VURAL yazdı:Yazdığınız koda bakalım.
Kod: Tümünü seç
dosyayolu = mm.Range("e" & a)


Excel "e" & a hücresindeki veriye bakalım.
C:\Users\MSB\Desktop\mail\a


Şimdi dosya yolu ne oldu ?
Kod: Tümünü seç
dosyayolu = "C:\Users\MSB\Desktop\mail\a"

... şeklinde oluştu.

Eğer dosya yolunda belirttiğiniz en sondaki a adında uzantısız bir dosyanız varsa mail eki olarak oluşur. Yok ise sistem bunu yorumlayamaz ve bir şey ekleyemez. Dosyanızı Excel hücresinde tanımlarken ya uzantısı ile birlikte ifade edin; ya da bu bir dosya değil klasör yolu ise aşağıdaki yöntemle deneyin.
Kod: Tümünü seç
.Body = mm.Range("d" & a)

klasoryolu = mm.Range("e" & a)
set evn = createobject("scripting.filesystemobject")
set klasor = evn.getfolder(klasoryolu)
for each dosya in klasor.files
.Attachments.Add dosya.path
next

.Send



Tarkan bey merhabalar.
Öncelikler verdiğiniz yararlı bilgiler için çok teşekkür ederiz.
Dosyayı ekleyen arkadaşa da teşekkür ederim.
Şöyle bir sorum olacaktı. Makronun son düzeninden bir önceki halini indirdim. Orada dediğiniz gibi dosya uzantılarını yazarak göndermeye çalıştım ek olarak mail gitmedi. En son halinde ise klasörün içindeki tüm dosyaları gönderiyor. acaba e" & a kesişimindeki dosya adresindeki dosyayı göndermenin başka bir yöntemi var mıdır. VBA'da çok yeni olduğum için çözümlemekte zorlandım. Yardımcı olabilirseniz sevinirim.
Kullanıcı avatarı
ufuk.korkmaz
 
Kayıt: 29 Nis 2016 14:44
Meslek: muhasebe
Yaş: 29
İleti: 3
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Dosya eklemeli çoklu mail

İleti#10)  Tarkan VURAL » 07 Kas 2018 12:45

Merhaba

Kod: Tümünü seç
dosya = S1.Cells(X, 5).Value
.Attachments.Add dosya


İşinizi görebilir. Tek dosya için dosya yolu ve adını yazın. For each döngüsü ile olan kısmı kullanmayın.
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26822
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

Cevap: Cevap: Dosya eklemeli çoklu mail

İleti#11)  ufuk.korkmaz » 07 Kas 2018 14:25

Tarkan VURAL yazdı:Merhaba

Kod: Tümünü seç
dosya = S1.Cells(X, 5).Value
.Attachments.Add dosya


İşinizi görebilir. Tek dosya için dosya yolu ve adını yazın. For each döngüsü ile olan kısmı kullanmayın.



Tarkan bey merhabalar.
Kodu değiştirerek denedim.
Dosya yolu ve uzantısını yazdım.
Fakat mail eksiz gidiyor acaba yanlış bir şey mi yapıyorum.
Hızlı yanıtınız için de çok teşekkür ederim.




Kod: Tümünü seç
Sub Mail()
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim strFile As String
   
   
    Dim mm As Worksheet
    Set mm = Sheets("Sayfa1")
    aa = mm.[b65536].End(3).Row
    For a = 2 To aa
   

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'strbody = "Hi there" & vbNewLine & vbNewLine & _
              "See attached" & vbNewLine


    On Error Resume Next
    With OutMail
        .To = mm.Range("b" & a)      'Email Address (can be a cell reference)
        .CC = ""
        .BCC = ""
        .Subject = mm.Range("c" & a)
        .Body = mm.Range("d" & a)
       
        klasoryolu = mm.Range("e" & a)
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.GetFolder(klasoryolu)
dosya = S1.Cells(X, 5).Value
.Attachments.Add dosya


        .Send                    'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    Next
End Sub


Kullanıcı avatarı
ufuk.korkmaz
 
Kayıt: 29 Nis 2016 14:44
Meslek: muhasebe
Yaş: 29
İleti: 3
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Dosya eklemeli çoklu mail

İleti#12)  ufuk.korkmaz » 07 Kas 2018 15:09

Tarkan bey merhabalar

Aşağıdaki şekilde düzelttim oldu :)

Kod: Tümünü seç
Sub Mail()
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim strFile As String
   
   
    Dim mm As Worksheet
    Set mm = Sheets("Sayfa1")
    aa = mm.[b65536].End(3).Row
    For a = 2 To aa
   

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'strbody = "Hi there" & vbNewLine & vbNewLine & _
              "See attached" & vbNewLine


    On Error Resume Next
    With OutMail
            .To = mm.Range("b" & a).Value
            .CC = ""
            .BCC = ""
            .Subject = mm.Range("c" & a).Value
            .Body = mm.Range("d" & a).Value
            .Attachments.Add mm.Range("e" & a).Value
            .Send
                     'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    Next
End Sub



Kullanıcı avatarı
ufuk.korkmaz
 
Kayıt: 29 Nis 2016 14:44
Meslek: muhasebe
Yaş: 29
İleti: 3
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Dosya eklemeli çoklu mail

İleti#13)  Tarkan VURAL » 07 Kas 2018 17:30

--)( Kolay gelsin.
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26822
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü


Forum Excel ile Mail İşlemleri

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 0 misafir

Bumerang - Yazarkafe