Arkadaşlar merhabalar,
Aşağıdaki kod ile müşterilerimize ara ara yüzlerce mail göndermekteyiz. Fakat bazı gönderdiğimiz mailler için ek eklemek gerekiyor. O zaman manuel mail göndermek zorunda kalıyoruz. Bu süreçte oldukça zaman alıyor.
Ekleri masa üstünde oluşturduğum klasöre koymaktayım. Hücredeki kodlar ve dosya içerisindeki excel isimleri ise 106.xls , 107.xls vs. şeklinde küçükten büyüğe göre sıralı olmaktadır.
Dosya yolu
D:\Users\ersalan\Desktop\EkDosyalar\Ekler
Yardım talep ettiğim kısım ise şudur;
Excel sayfasında D2,D3,D4,D5 alt alta gelen hücrelerdeki yazan kodlar ile masaüstüne eklediğim klasör içerindeki excel isimleri eşleşiyor ise eşleşen excelin mail gönderirken ek olarak eklemesini istiyorum.
Fakat bir türlü yapamadım. Aşağıdaki kodu revize edebilirseniz çok çok memnun olacağız.
Sub API_ile_EMail_Yolla()
Dim Email As String, Konu As String, Mesaj As String, URL As String, i As Integer
For i = 2 To Range("a65536").End(3).Row
Email = Cells(i, 21) ' To mail adresi
CC = "?cc=" & Cells(i, 22) 'CC mail adresi
Konu = "S.No: " & Cells(i, 19) & " * * * Acildir " & " Poliçe No: " & Cells(i, 11) '& " Sıra No: " & Cells(i, 19)
'Konu = Cells(i, 19) & " - * * * Acildir / Eksik " & " Poliçe No: " & Cells(i, 11)
SendKeys ("^~") 'Mesaj gövdemizi hazırlayalım
Mesaj = "" 'Kesinlikle olmalı olmazsa bütün mailler alt alt agelir.
Mesaj = Mesaj & "Merhabalar," & vbCrLf & vbCrLf
Mesaj = Mesaj & "Önemli:" & vbCrLf & vbCrLf
Mesaj = Mesaj & "Aşağıda yer alan müşteriye ait evrakların vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Gelir belgesi eksiklikleri için vs." & vbCrLf
Mesaj = Mesaj & "Tabloda belirtilen ürün sistemde vs." & vbCrLf
Mesaj = Mesaj & "Tüm dönüşlerin e-mail aracılığı ile yapılması vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Sisteme taranmayan vs." & vbCrLf
Mesaj = Mesaj & "Bundan sonraki süreçte vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Saygılarımızla," & vbCrLf
Mesaj = Mesaj & "İyi çalışmalar dileriz." & vbCrLf
Mesaj = Mesaj & "" & vbCrLf & vbCrLf
'Mesaj = Mesaj & Operasyon Bölümü" & vbCrLf
'Mesaj = Mesaj & "Tel: " & vbCrLf
'Mesaj = Mesaj & "Fax: " & vbCrLf
Konu = Application.WorksheetFunction.Substitute(Konu, " ", "%20") 'Boşlukları html mantığının alayacağı şekle dönüştürelim
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, " ", "%20")
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, vbCrLf, "%0D%0A") 'Satır boşluk verdirmeyi de dönüştürelim
URL = "mailto:" & Email & CC & "&Subject=" & Konu & "&body=" & Mesaj
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus 'Oaysız mail gönderelim
Application.Wait (Now + TimeValue("0:00:03")) 'Mailler üç zaniye arayla gönderilsin
SendKeys ("^~") 'Mesajımızı sendkeys ile tıklatmış gibi gönderelim, bitsin gitsin.
Next i
MsgBox Range("a65536").End(3).Row - 1 & " Adet mail gönderilmiştir", vbInformation, "Operasyonları Bölümü"
Aşağıdaki kod ile müşterilerimize ara ara yüzlerce mail göndermekteyiz. Fakat bazı gönderdiğimiz mailler için ek eklemek gerekiyor. O zaman manuel mail göndermek zorunda kalıyoruz. Bu süreçte oldukça zaman alıyor.
Ekleri masa üstünde oluşturduğum klasöre koymaktayım. Hücredeki kodlar ve dosya içerisindeki excel isimleri ise 106.xls , 107.xls vs. şeklinde küçükten büyüğe göre sıralı olmaktadır.
Dosya yolu
D:\Users\ersalan\Desktop\EkDosyalar\Ekler
Yardım talep ettiğim kısım ise şudur;
Excel sayfasında D2,D3,D4,D5 alt alta gelen hücrelerdeki yazan kodlar ile masaüstüne eklediğim klasör içerindeki excel isimleri eşleşiyor ise eşleşen excelin mail gönderirken ek olarak eklemesini istiyorum.
Fakat bir türlü yapamadım. Aşağıdaki kodu revize edebilirseniz çok çok memnun olacağız.
Sub API_ile_EMail_Yolla()
Dim Email As String, Konu As String, Mesaj As String, URL As String, i As Integer
For i = 2 To Range("a65536").End(3).Row
Email = Cells(i, 21) ' To mail adresi
CC = "?cc=" & Cells(i, 22) 'CC mail adresi
Konu = "S.No: " & Cells(i, 19) & " * * * Acildir " & " Poliçe No: " & Cells(i, 11) '& " Sıra No: " & Cells(i, 19)
'Konu = Cells(i, 19) & " - * * * Acildir / Eksik " & " Poliçe No: " & Cells(i, 11)
SendKeys ("^~") 'Mesaj gövdemizi hazırlayalım
Mesaj = "" 'Kesinlikle olmalı olmazsa bütün mailler alt alt agelir.
Mesaj = Mesaj & "Merhabalar," & vbCrLf & vbCrLf
Mesaj = Mesaj & "Önemli:" & vbCrLf & vbCrLf
Mesaj = Mesaj & "Aşağıda yer alan müşteriye ait evrakların vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Gelir belgesi eksiklikleri için vs." & vbCrLf
Mesaj = Mesaj & "Tabloda belirtilen ürün sistemde vs." & vbCrLf
Mesaj = Mesaj & "Tüm dönüşlerin e-mail aracılığı ile yapılması vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Sisteme taranmayan vs." & vbCrLf
Mesaj = Mesaj & "Bundan sonraki süreçte vs." & vbCrLf & vbCrLf
Mesaj = Mesaj & "Saygılarımızla," & vbCrLf
Mesaj = Mesaj & "İyi çalışmalar dileriz." & vbCrLf
Mesaj = Mesaj & "" & vbCrLf & vbCrLf
'Mesaj = Mesaj & Operasyon Bölümü" & vbCrLf
'Mesaj = Mesaj & "Tel: " & vbCrLf
'Mesaj = Mesaj & "Fax: " & vbCrLf
Konu = Application.WorksheetFunction.Substitute(Konu, " ", "%20") 'Boşlukları html mantığının alayacağı şekle dönüştürelim
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, " ", "%20")
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, vbCrLf, "%0D%0A") 'Satır boşluk verdirmeyi de dönüştürelim
URL = "mailto:" & Email & CC & "&Subject=" & Konu & "&body=" & Mesaj
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus 'Oaysız mail gönderelim
Application.Wait (Now + TimeValue("0:00:03")) 'Mailler üç zaniye arayla gönderilsin
SendKeys ("^~") 'Mesajımızı sendkeys ile tıklatmış gibi gönderelim, bitsin gitsin.
Next i
MsgBox Range("a65536").End(3).Row - 1 & " Adet mail gönderilmiştir", vbInformation, "Operasyonları Bölümü"