excel sheetin belli bir bolumunu coklu mail atma

[Bsybsy]

Selam,

A3 hucresinden asagiya dogru 50 satir boyunca devam eden mail adreslerine ayri ayri ilgili mail adresinin saginda 50 sutun ( c1, d1, e1 ... Olarak devam ediyor- bu arada rakamlarin uzerindeki basliklarda alinmali) boyunca devam eden bilgileri outlook ile excel eki olarak yollamak istiyorum. Bu arada b sutununda yer alan konu kisminin mailin konusunda yazili olmasi ve mailin icerik kisminda da kucuk bir aciklama eklemeliyim.

Excelin icine yerlestirilmis gonder butonuna bastigimda sirayla ilgili maile sadece kendisinin rakamlarini mail atabilirsem super olur.

Destek olabilecek, bu makroyu yazabilecek exceli konusturan bir prof. cikarsa cook mutlu,mesut, bahtiyar olurum.)

Excelim ingilizcedir.
Saygilar

 

[askm]

Örnek dosya eklerseniz yardımcı olmaya çalışalım. Ek dosya excel formatında mı istiyorsunuz, yoksa mailin gövdesinde yapıştırılacak şekilde mi istiyorsunuz.

 

[Bsybsy]

Bsybsy excel sheetin belli bir bolumunu coklu mail atma

Selam
Ek dosya mailin ekinde excel olarak olursa cok iyi olur..

 

[askm]

Başka üstat bakmazsa yarın gün içerisinde kod eklerim.

 

[Bsybsy]

Cok minnettar olurum..tsk ler.

 

[hoguz2]

merhaba,

Bu işle daha once ugrasmis biri olarak bir konuyu daha düşünmenizi tavsiye ederim.

outlook dan ya da her neyse bir mailden 50-60 kişiye aynı anda ya da arkasi arkasina ayrı ayrı mailler dahi olsa gondermeye kalktiginiz zaman mailleriniz spam a duser ve bunu sık sık yapmaya devam ederseniz kara liste bile olabilir. normal mailleriniz bile spam olur.

dolayısıyla bence kodlar su sekilde dusunulmeli : zamanlanmis gorevle belli araliklarla calistirarak ya da Application.OnTime vs yontemlerle mailler parti parti gonderilmesi gerekir. Ayrica outlook unda guvenlik ayarini dusurmek gerekecektir. VBA dan outlook a emir gonderdiginizde dis program otomatik mail gondermeye calisiyor diye uyari verir...

iyi calismalar,

 

[Bsybsy]

Selam
Peki makro yazabilir misiniz dedigim sekilde

 

[askm]

Örnek dosyanızı eklerseniz daha iyi olacaktı. Aşağıdaki kodlar ile deneyin.

Sub ASKM_Mail_Secim()
    Dim SecimAlani As Range
    Dim Kitap1 As Workbook
    Dim Kitap2 As Workbook
    Dim GeciciDosyaYeri As String
    Dim GeciciDosyaAdi As String
    Dim Uzanti As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim SonSat As Long

SonSat = Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To SonSat
    Set SecimAlani = Nothing
    On Error Resume Next
    Set SecimAlani = Range("C1:J1,C" & i & ":J" & i) 'C ile J aralığını mail atıyor.
    On Error GoTo 0
    Alici = Cells(i, "B").Value

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Kitap2 = ActiveWorkbook
    Set Kitap1 = Workbooks.Add(xlWBATWorksheet)
    SecimAlani.Copy
    With Kitap1.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    GeciciDosyaYeri = Environ$("temp") & "\"
    GeciciDosyaAdi = "Seçili Alan " & Kitap2.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        Uzanti = ".xls": FileFormatNum = -4143
    Else
        Uzanti = ".xlsx": FileFormatNum = 51
    End If

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

    With Kitap1
        .SaveAs GeciciDosyaYeri & GeciciDosyaAdi & Uzanti, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = Alici
            .CC = ""
            .BCC = ""
            .Subject = "Gönderilecek Olan Mailin Konusu"
            .Body = "Mail içerisinde eklenecek ifadeler..."
            .Attachments.Add Kitap1.FullName
            
            '.Display 'Bekletmek için
            .Send 'Direkt göndermek için
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill GeciciDosyaYeri & GeciciDosyaAdi & Uzanti
    Cells(i, "L").Value = "Mail Gönderildi."
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Application.Wait Now + TimeValue("00:00:03")
Next
MsgBox "İşlem Tamam!...", vbInformation, "ASKM"
End Sub

 

[Bsybsy]

Cok tesekkurler..super..

 

[askm]

Rica ederim.