Farklı sheetlerden farklı yerlere mail gönderme

[u.L.a.s]

Merhabalar

Elimde Aşağıdaki gibi bir makro kod düzeneğim var. bu kod ile ben aslında Sheet1 altında bulunan bazı verilerimi seçip bu makroyu çalıştırıp tanımladığım maillere otomatik mail atılmasını sağlıyorum.

Ama bunu Sheet2 de ben farklı bir sayfa olduğu için farklı bir yere mail atmak istiyorum. Şu anki bu kod düzeneğinde hangi sheette hangi hücreleri gönderip makroyu çalıştırsam tanımlanmış maile gidiyor.

Acaba aşağıda kırmızı renkel işaretlediğim yerde bir if gibi birşeyle çözebilir miyiz bu durumu. Yani eğer Sheet1 de seçtiğim hücreler atıyorum xxx@mail.com a gitsin.

ama sheet2 de seçtiğim hücreler yyy@mail.com a gitsin.

hatta sheet3 te seçtiklerimde zzz@mail.com a gitsin.

ama tabi sheet1 te seçtiğim sadece xxx e gidecek yyy ve zzz ye tanımlı maillere gitmeyecek.

Bilgi ve yardımlarınızı rica ederim

Sub Mail_Selection_Range_Outlook_Body()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2013
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

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

    On Error Resume Next
    [COLOR="Red"][B]With OutMail
        .Display
        .To = "adim.soyadim@mail.com"
        .CC = ""
        .BCC = ""
        .Subject = Hat Tesisi ve Kontrolü Hk."
        .HTMLBody = "Merhaba," & "<br><br>" & _
                    "Belirtilen cihazlara ait hattın/hatların tesisi tamamlanmış olup kontrolünün yapılmasını rica ederim" & "<br>" & _
                    RangetoHTML(rng) & "<br>" & _
                   .HTMLBody
        '.HTMLBody = "Merhaba" & Chr(13) & "Belirtilen cihaza ait hattın tesisi tamamlanmış olup kontrolünün yapılmasını rica ederim" & Chr(13) & RangetoHTML(rng) 'Range("Z1:AB7")
        .Send   'or use .Display
    End With[/B][/COLOR]
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[programer]

Sayın u.L.a.s aşağıdaki gibi bir denermisiniz.

Dim Sayfa As String
Sayfa = ActiveSheet.Name
If Sayfa = "Sheet1" Then
   .To = xxx@mail.com
End If
If Sayfa = "Sheet2" Then
   .To = yyy@mail.com
End If
If Sayfa = "Sheet3" Then
  .To = zzz@mail.com
End If

 

[u.L.a.s]

Çok teşekkürler üstadım kod düzeneğinde With kısmından sonraki alanlarda şu düzenlemeleri yaptım. ve istediğim şey oldu

Bilginize emeğinize sağlık

Kod düzenin başına

Dim Sayfa As String
Sayfa = ActiveSheet.Name

With kısmı

 With OutMail
        .Display
         If Sayfa = "Sheet1" Then
        .To = "xxx@mail.com"
        .Subject = "Hat Tesisi"
        .CC = "aaa@mail.com"
        .HTMLBody = "Merhaba," & "<br><br>" & _
                    "Belirtilen cihazlara asdvasdvasdv" & "<br>" & _
                    RangetoHTML(rng) & "<br>" & _
                   .HTMLBody
        End If
        .Display
        If Sayfa = "Sheet2" Then
        .To = "yyy@mail.com.tr"
        .Subject = "Referans Telefon Sorgulama"
        .CC = "aaa@mail.com"
        .HTMLBody = "Merhaba," & "<br><br>" & _
                    "cihazımız için dsvasdvasdvasd" & "<br>" & _
                    RangetoHTML(rng) & "<br>" & _
                   .HTMLBody
        End If
        Display
         If Sayfa = "Sheet3" Then
        .To = "zzz@mail.com"
        .Subject = "Kutu Sorgulama"
        .CC = "aaa@mail.com"
        .HTMLBody = "Merhaba," & "<br><br>" & _
                    "Belirtilen hattınacscascascascacascac" & "<br>" & _
                    RangetoHTML(rng) & "<br>" & _
                   .HTMLBody
        End If
        .Send   'or use .Display
    End With

 

[programer]

Rice ederim iyi çalışmalar.