• DİKKAT

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

Excel'den Mail Gönderme (ilgili satırdan veri çekmek)

T

tirEdsOuL

Altın Üye
Katılım
3 Şubat 2009
Mesajlar
326
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba;

Yüzlerce satırdan oluşan sayfamda K sütununa yazdığım "mail" yazısına istinadan ilgili satırda ki bazı hücreleri mail şablonuna otomatik akmasını istiyorum. Ek'te daha detaylı anlatım mevcuttur.

Yardımlarınız için şimdiden teşekkürler..
 

Ekli dosyalar

.

Mail gönderme işlemi yapılabilir.
Ancak burada uğraştıran iyelik ekleri olacak gibi
Aaa' ya
Excel' e vs.
Forumda iyelik ve aitlik ekleriyle ilgili örnekler var onları kendinize göre revize etmeye çalışın sizin isimlerinize uygun hale getirince mail kısmını inceleyelim.

.
 
O zaman şablonu cümle kurmaktan çıkartıp aşağıdaki şekilde değiştirebiliriz Emir bey..

-
Aşağıda bilgileri verilen araç için Garanti bankasına ödemeniz yapılmıştır.

Plaka : xxxx
Satıcı : aaaa
Müşteri: bbbb
Takas Bedeli : 60.000 TL
-
 
. . .

Aşağıdaki kodları deneyin. İmzanızın maile eklenmesi için.
İmzanızın htm dosya yolunu kırmızı ile belirttiğim alana kaydetmelisiniz.

Kod: 
Sub kod()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    
    Dim SS As Worksheet: Set SS = Sheets("Stok")
    Dim xlOutlook   As Object
    Dim xlMail      As Object
      
    For i = 2 To SS.Cells(Rows.Count, "K").End(3).Row
        If UCase(Replace(SS.Cells(i, "K"), "i", "İ")) = "MAİL" Then
            
            Set xlOutlook = CreateObject("Outlook.Application")
            Set xlMail = xlOutlook.CreateItem(0)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    yol = "[COLOR="Red"]C:\Users\Hüseyin\AppData\Roaming\Microsoft\Signatures\imzaara.htm[/COLOR]"
    Set imza = FSO.OpenTextFile(yol, 1)

            With xlMail
                .To = "birinci@mail.com;ikinci@mail.com"
                .CC = "bilgibirinci@mail.com;bilgiikinci@mail.com"
                .Subject = "2.EL - " & SS.Cells(i, "E") & " - " & SS.Cells(i, "B")
     [COLOR="DarkGreen"]           '.Body = ""[/COLOR]
                .HTMLBody = "<font face=tahoma>" & "Aşağıda bilgileri verilen araç için Garanti bankasına ödemeniz yapılmıştır." & "<BR><BR>" & _
                "Plaka : " & SS.Cells(i, "B") & "<br>" & _
                "Satıcı : " & SS.Cells(i, "E") & "<br>" & _
                "Müşteri : " & SS.Cells(i, "H") & "<br>" & _
                "Takas Bedeli : " & Format(SS.Cells(i, "J"), "#,##0.00") & " TL." & "<br><br>" & _
                "Saygılarımla.." & "</font>" & "<BR><BR>" & imza.readall
                .Save
                .Display
[COLOR="DarkGreen"]                '.Send[/COLOR]
                
            End With
        End If
    Next i
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

. . .
 
Son düzenleme:
Ellerinize sağlık Emir bey sorunsuz olarak çalışıyor çok teşekkür ederim.

Çok önemli olmamakla beraber, şöyle birşey de yapılabilir mi acaba..
Birden fazla satır için bu bilgiler getirilebilir mi?

Örn.
Plaka : xxxx
Satıcı : aaaa
Müşteri: bbbb
Takas Bedeli : 60.000 TL
-
Plaka : xxx
Satıcı : aaa
Müşteri: bbb
Takas Bedeli : 49.000 TL
-
Plaka : xx
Satıcı : aa
Müşteri: bb
Takas Bedeli : 53.000 TL
-
 
. . .

Tüm mail yazan satırlar tek mail mi olacak...

. . .
 
Evet Emir bey, bu haliyle zaten her birine yeni mail sayfası açıyor.
 
tirEdsOuL' Alıntı:
Ellerinize sağlık Emir bey sorunsuz olarak çalışıyor çok teşekkür ederim.

Çok önemli olmamakla beraber, şöyle birşey de yapılabilir mi acaba..
Birden fazla satır için bu bilgiler getirilebilir mi?

Örn.
Plaka : xxxx
Satıcı : aaaa
Müşteri: bbbb
Takas Bedeli : 60.000 TL
-
Plaka : xxx
Satıcı : aaa
Müşteri: bbb
Takas Bedeli : 49.000 TL
-
Plaka : xx
Satıcı : aa
Müşteri: bb
Takas Bedeli : 53.000 TL
-
Genişletmek için tıkla ...
. . .

Kod: 
Sub kod2()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
       
    Dim SS As Worksheet: Set SS = Sheets("Stok")
    Dim xlOutlook   As Object
    Dim xlMail      As Object

    For i = 2 To SS.Cells(Rows.Count, "K").End(3).Row
        If UCase(Replace(SS.Cells(i, "K"), "i", "İ")) = "MAİL" Then
            metin = metin & "Plaka : " & SS.Cells(i, "B") & "<br>" & _
            "Satıcı : " & SS.Cells(i, "E") & "<br>" & _
            "Müşteri : " & SS.Cells(i, "H") & "<br>" & _
            "Takas Bedeli : " & Format(SS.Cells(i, "J"), "#,##0.00") & " TL." & "<br>-<br>"
        End If
    Next i
    
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    yol = "C:\Users\Hüseyin\AppData\Roaming\Microsoft\Signatures\imzaa.htm"
    Set imza = FSO.OpenTextFile(yol, 1)
    
    With xlMail
        .To = "birinci@mail.com;ikinci@mail.com"
        .CC = "bilgibirinci@mail.com;bilgiikinci@mail.com"
        .Subject = "2.EL - " & SS.Cells(i, "E") & " - " & SS.Cells(i, "B")
        .HTMLBody = "<font face=tahoma>" & "Aşağıda bilgileri verilen araç için Garanti bankasına ödemeniz yapılmıştır." & "<BR><BR>" & _
        metin & "<br>" & "Saygılarımla.." & "</font>" & "<BR><BR>" & imza.readall
        .Save
        .Display
        '.Send
    End With
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    metin = Empty
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

. . .
 
Çok teşekkürler Emir bey, yalnız ufak bir sorun var..

Birden fazla satırın bilgilerini getirdiği için Konu kısmını sadece "2.EL - -" olarak getiriyor. Bunu da çözebilirsek, "2.EL Takas Ödemeleri - Plaka1 - Plaka2" gibi çözebiliriz. Mümkün değil ise "2.EL Takas Ödemeleri" diyip de geçebilirim.

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

Konu kısmına en fazla kaç karakter girilebiliyor test etmek gerek.
Çok fazla plaka olduğunda sorun çıkarabilir.

.Subject = "2.EL Takas Ödemeleri"

olarak değiştirebilirsiniz.

. . .
 
Konu alanına en fazla 255 karakter yazılabiliyor. En fazla 10 tane aracın plakasının yazıldığını varsayarsak (şimdiye kadar o kadar olmadı) en fazla 130 karakter kullanmış oluruz.

Teşekkürler.
 
tirEdsOuL' Alıntı:
Konu alanına en fazla 255 karakter yazılabiliyor. En fazla 10 tane aracın plakasının yazıldığını varsayarsak (şimdiye kadar o kadar olmadı) en fazla 130 karakter kullanmış oluruz.
Teşekkürler.
Genişletmek için tıkla ...
. . .

Kod: 
Sub kod()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
       
    Dim SS As Worksheet: Set SS = Sheets("Stok")
    Dim xlOutlook   As Object
    Dim xlMail      As Object

    For i = 2 To SS.Cells(Rows.Count, "K").End(3).Row
        If UCase(Replace(SS.Cells(i, "K"), "i", "İ")) = "MAİL" Then
            metin = metin & "Plaka : " & SS.Cells(i, "B") & "<br>" & _
            "Satıcı : " & SS.Cells(i, "E") & "<br>" & _
            "Müşteri : " & SS.Cells(i, "H") & "<br>" & _
            "Takas Bedeli : " & Format(SS.Cells(i, "J"), "#,##0.00") & " TL." & "<br>-<br>"
  [B]           plaka = " - " & SS.Cells(i, "B") & plaka[/B]
        End If
    Next i
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    yol = "C:\Users\Hüseyin\AppData\Roaming\Microsoft\Signatures\imzaa.htm"
    Set imza = FSO.OpenTextFile(yol, 1)
    
    With xlMail
        .To = "birinci@mail.com;ikinci@mail.com"
        .CC = "bilgibirinci@mail.com;bilgiikinci@mail.com"
[B]        .Subject = Left("2.EL Takas Ödemeleri" & plaka, 255)[/B]
        .HTMLBody = "<font face=tahoma>" & "Aşağıda bilgileri verilen araç için Garanti bankasına ödemeniz yapılmıştır." & "<BR><BR>" & _
        metin & "<br>" & "Saygılarımla.." & "</font>" & "<BR><BR>" & imza.readall
        .Save
        .Display
        '.Send
    End With
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    metin = Empty: plaka=empty
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
. . .
 
Ellerinize sağlık Emir bey, çok teşekkürler..

İyi çalışmalar..
 
Hüseyin bey tekrar merhaba;

Farklı bir çalışma sayfamda da buna benzer birşey yapmak istiyorum, yalnız burada bilgilerimi tablo halinde maile ekletmek istiyorum çünkü bilgilerini almak istediğim onlarca satır olabiliyor.

Ayrıca aynı şablondan sayfa adları Otomobil - HTA - Kamyon olan 3 sayfa mevcut ve kodun bu 3 sayfa için aynı anda çalışmasını istiyorum.


Düzenlediğim kod;
Kod: 
Sub kods()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
       
    Dim SS As Worksheet: Set SS = Sheets("Kamyon")
    Dim xlOutlook   As Object
    Dim xlMail      As Object

    For i = 2 To SS.Cells(Rows.Count, "A").End(3).Row
        If UCase(Replace(SS.Cells(i, "A"), "i", "İ")) = "2" Then
            metin = metin & "Banka : " & SS.Cells(i, "B") & "   " & "<br>" & _
            "Tarih : " & SS.Cells(i, "C") & "<br>" & _
            "Sipariş No : " & SS.Cells(i, "D") & "<br>" & _
            "Araç Tipi : " & SS.Cells(i, "E") & "<br>" & _
            "Durumu : " & SS.Cells(i, "H") & "<br>" & _
            "Araç Bedeli : " & Format(SS.Cells(i, "F"), "#,##0.00") & " TL" & "<br>-<br>"
            aciklama = "Aşağıda bilgileri verilen araçlar kredili olarak alınacaktır."
        End If
    Next i
    
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    yol = "C:\Users\ebulut\AppData\Roaming\Microsoft\Signatures\İmza.htm"
    Set imza = FSO.OpenTextFile(yol, 1)
    
    With xlMail
        .To = "x@x.com.tr"
        .CC = "y@y.com.tr;z@z.com.tr"
        .Subject = "Kredili Alım Hk."
        .HTMLBody = "<font face=calibri>" & aciklama & "<BR><BR>" & _
        metin & "</font>" & "<BR><BR>" & imza.readall
        .Save
        .Display
        '.Send
    End With
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    metin = Empty
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

mailimde ise ekli fotoğraftaki gibi "I" sütunu hariç görünmesini istiyorum.
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    46.6 KB · Görüntüleme: 5
. . .

Biraz daha açıklama gerekiyor.
Yapılmak istenen nedir. Adım adım anlatınız...
Gerekirse en son gönderilecek olan mailin örneğini bana gönderin.

. . .
 
Otomobil - HTA ve Kamyon sayfalarında yer alan "A" sütunundaki "2" yazan satırları ekli resim görselinde ki gibi mail sayfasına akmasını istiyorum.
 

Ekli dosyalar

  • Ekran Alıntısı1.JPG
    Ekran Alıntısı1.JPG
    99.7 KB · Görüntüleme: 7
  • Araç Takibi-2016.xls
    Araç Takibi-2016.xls
    290.5 KB · Görüntüleme: 3
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst