Excel Tabloyu Makro ile Mail İçine Gömerek Mail Gönderme

Merhaba,

         İşinize yarayacağını düşündüğüm bir çalışmayı daha sizinle paylaşmak istiyorum.

Makronun amacı,

         Her gün revize ettiğimiz ve iş arkadaşlarımıza attığımız bir tablo var.Bizdeki kullanım amacı her müşteri temsilcisinin hangi fason parçasının kritik olduğunu belirten bir tablo.Bu makro datanın pivotunu alıyor ve ilgili kişileri de maile ekliyor.Maile hem excel tabloyu ekliyor , hemde mail gövdesine kritik parçaların olduğu pivotu ekliyor.Açıkçası zamandan tasarruf yapmamızı ve yaptırmamızı sağlıyor.Özellikle müşteri temsilcisi telefondan maile bakma konusunda her gelen maildeki exceli açmak zorunda kalmadan mail ana gövdesinde kritik parçası varmı yokmu kontrol edebiliyor.Umarım faydalı bir çalışma olmuştur.

Yapmamız gerekenler sırasıyla aşağıdaki gibidir;

•      Öncelikle toplamda 3 ayrı sheet(sayfa) de işlem yapacağız.Aşağıdaki gibi VERİLER adında bir datamız var.Fason stokları kontrol eden ve müşteri temsilcisi arkadaşlara raporlayan arkadaşımızın tuttuğu tablo.Siz kendinize göre tabloyu revize edebilirsiniz.Tablonuzu oluşturduktan sonra aşağıda da görüldüğü gibi bir adet gönder butonu oluşturunuz. Makromuzu oluşturduğumuzda makroyu bu butona atayacağız.

•  pivot adında ayrı bir sheete oluşturun ve aşağıdaki gibi görünüme ayarlayınız.

•      Listedeki isme göre outlook a mail adresini eklemesi için aşağıdaki gibi bir formatta Mailler adında ayrı bir sheet e formüllü bir tablo yapmalısınız.Bu formulde şu kuralı kullanın. VERİLER sayfasındaki NKARA ,Mailler sayfasında "A" sütunundaki isimle eşleşiyorsa ilgili kişinin mail adresini "B" sütununa yaz.Bunun içinde yandaki bir sütuna her ismin karşısına mail adresini yazın oradan formül ile bağlantı kurunuz.

•     Son olarak makroyu oluşturma sırasındayız. Excelimizin Developer(Geliştirici) kod bölümde Visual basic kısmına girdiğimizde sayfa kod görünümümüz aşağıdaki gibi olacaktır.3 sayfa Mailler,Veriler,Pivot. Biz buraya sadece 1 adet module ekliyoruz. İçine aşağıdaki kodları ekleyeceğiz.Geriye sadece veriler sayfamıza gelip Gönder butonumuza oluşturduğumuz makroyu atamaktır.

MAKRO KODLARI

Sub Mail_workbook_Outlook_1() Dim OutApp As Object Dim OutMail As Object Dim mailToAddress As String Dim mailCCAddress As String Dim sh As Worksheet Dim Rcount As Long Dim Rnum As Long Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) 'Look for the mail address in the MailInfo worksheet mailCCAddress = "" mailToAddress = "" For Each sh In ThisWorkbook.Worksheets If sh.Name = "Mailler" Then Rcount = Application.WorksheetFunction.CountA(sh.Columns(2)) If Rcount >= 2 Then For Rnum = 2 To Rcount On Error Resume Next mailCCAddress = mailCCAddress + ";" + Application.WorksheetFunction. _ VLookup(sh.Cells(Rnum, 1).Value, _ Worksheets("Mailler").Range("A1:B" & _ Worksheets("Mailler").Rows.Count), 2, False) mailToAddress = mailToAddress + ";" + Application.WorksheetFunction. _ VLookup(sh.Cells(Rnum, 3).Value, _ Worksheets("Mailler").Range("C1:D" & _ Worksheets("Mailler").Rows.Count), 2, False) On Error GoTo 0 Next Rnum End If End If Next sh Set sh = ThisWorkbook.Worksheets("pivot") With sh .PivotTables("PivotTable2").PivotCache.Refresh .Range("A1").CurrentRegion.Copy End With Dim wordDoc As Object On Error Resume Next With OutMail .To = mailCCAddress .CC = mailToAddress .BCC = "" .Subject = "Fason Bakiye Riskleri Bildirimi" .Body = "Merhaba, Fason stoğu eksik referanslar ekte paylaşılmışdır.Müşteri ve montaj hatlarımızda sorun yaşanmaması adına bilginize sunarız." .Attachments.Add ActiveWorkbook.FullName .Display 'or use .Send Set wordDoc = .GetInspector.WordEditor wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub