2 ayrı e-mail gönderme

[sfu420]

Arkadaşlar Merhaba,

Forum sayesinde istediğim üretim emrini oluşturdum fakat farklı bir ihtiyaç doğdu.

Alttaki kurguda anlayacağınız gibi AE1=FALSE ise "No" seçildiğinde makro iptal ediliyor. "Yes" seçildiğinde ise aşağıdaki kurguyu aynen uygulacak, ilaveten ayrıca bir mail daha gönderecek direkt olarak(.send)

Tabi birde AE1=TRUE olma durumu var. Ozaman gene sadece aşağıdaki kurala göre mail gönderecek.

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

If Worksheets("Şablon").Range("AE1") = "FALSE" Then Response = MsgBox("Kırmızı işaretli fiyat/lar olması gereken seviyenin altındadır." & vbLf & "Yöneteci onayınız var mı?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbNo Then MsgBox "Üretim iptal edildi.", vbCritical, "Eksik/Hatalı İşlem": Cancel = True: Exit Sub

If MsgBox("Kaydet işlemini onaylıyor musunuz?", vbYesNo, "UYARI") = vbNo Then Exit Sub
ThisWorkbook.SaveAs ("\\ALAN-K\Kayis\Genel\DEPO\Uretim_Emirleri\" & Sheets("Şablon").Range("ah5").Value & ".xls")

Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim MyFile As String
MyFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = "xxxx"
.CC = ""
.Subject = [ah5]
.Body = [Ah6] & vbLf & " " & vbLf & "Üretime alınmasını rica ederim." & vbLf & " " & vbLf & "İyi çalışmalar." & vbLf & " " & vbLf & " " & vbLf & [D3]
.Attachments.Add MyFile
.Save
.Display
End With
Set NewMail = Nothing
Set OutApp = Nothing


End Sub

 

[sfu420]

Arkadaşlar yokmudur yardımcı olabilecek kimse

 

[Zeki Gürsoy]

Deneyin...

[COLOR=DarkGreen]' If Worksheets("Şablon").Range("AE1") = "FALSE" Then[/COLOR]

    Response = MsgBox("Kırmızı işaretli fiyat/lar olması gereken seviyenin altındadır." & _
                vbLf & "Yöneteci onayınız var mı?", vbYesNo + vbInformation + vbDefaultButton2)

    If Response = vbNo Then
        MsgBox "Üretim iptal edildi.", vbCritical, "Eksik/Hatalı İşlem"
        Cancel = True: Exit Sub
    End If

    If MsgBox("Kaydet işlemini onaylıyor musunuz?", vbYesNo, "UYARI") = vbNo Then Exit Sub
    
    ThisWorkbook.SaveAs ("\\ALAN-K\Kayis\Genel\DEPO\Uretim_Emirleri\" & Sheets("Şablon").Range("ah5").Value & ".xls")
    
    Dim OutApp As Outlook.Application
    Dim NewMail As Outlook.MailItem
    Dim MyFile As String
    
    MyFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    
    Set OutApp = New Outlook.Application
    Set NewMail = CreateItem(olMailItem)
    
    With NewMail
        .To = "xxxx"
        .CC = ""
        .Subject = [ah5]
        .Body = [Ah6] & vbLf & " " & vbLf & "Üretime alınmasını rica ederim." & _
                vbLf & " " & vbLf & "İyi çalışmalar." & vbLf & " " & vbLf & " " & vbLf & [D3]
        .Attachments.Add MyFile
        .Save
        
        [COLOR=Blue][B]If Worksheets("Şablon").Range("AE1") = "FALSE" Then
            .Display
        Else
            .send
        End If[/B][/COLOR]
        
    End With
    
    Set NewMail = Nothing
    Set OutApp = Nothing

[COLOR=DarkGreen]' End If[/COLOR]

 

[sfu420]

Deneyin...

[COLOR=DarkGreen]' If Worksheets("Şablon").Range("AE1") = "FALSE" Then[/COLOR]

    Response = MsgBox("Kırmızı işaretli fiyat/lar olması gereken seviyenin altındadır." & _
                vbLf & "Yöneteci onayınız var mı?", vbYesNo + vbInformation + vbDefaultButton2)

    If Response = vbNo Then
        MsgBox "Üretim iptal edildi.", vbCritical, "Eksik/Hatalı İşlem"
        Cancel = True: Exit Sub
    End If

    If MsgBox("Kaydet işlemini onaylıyor musunuz?", vbYesNo, "UYARI") = vbNo Then Exit Sub
    
    ThisWorkbook.SaveAs ("\\ALAN-K\Kayis\Genel\DEPO\Uretim_Emirleri\" & Sheets("Şablon").Range("ah5").Value & ".xls")
    
    Dim OutApp As Outlook.Application
    Dim NewMail As Outlook.MailItem
    Dim MyFile As String
    
    MyFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    
    Set OutApp = New Outlook.Application
    Set NewMail = CreateItem(olMailItem)
    
    With NewMail
        .To = "xxxx"
        .CC = ""
        .Subject = [ah5]
        .Body = [Ah6] & vbLf & " " & vbLf & "Üretime alınmasını rica ederim." & _
                vbLf & " " & vbLf & "İyi çalışmalar." & vbLf & " " & vbLf & " " & vbLf & [D3]
        .Attachments.Add MyFile
        .Save
        
        [COLOR=Blue][B]If Worksheets("Şablon").Range("AE1") = "FALSE" Then
            .Display
        Else
            .send
        End If[/B][/COLOR]
        
    End With
    
    Set NewMail = Nothing
    Set OutApp = Nothing

[COLOR=DarkGreen]' End If[/COLOR]

Ustadım çok sağolasın ama ben eksik yazmışım istediğim şeyi.

.send tarafı ayrı bir mail olacak. Yani kuralın uyumsuzluğu durumunda 1. e-mail .display olacak belirtilen kişilere gidecek, 2. e-mail .send olarak yöneticiye direk gidecek.