Zamanlı mail

[muratgunay48]

Arkadaşlar, sayın hocalarım, kullandığım bir mail dosyası var.
Normal çalışıyor.
Bunu I4 hücresine yazacağım zamanda otomatik göndertmek mümkün mü?
Teşekkür ederim.
Saygılarımla.

 

[muhasebeciyiz]

Aşağıdaki kodu çalışma sayfasının kod penceresine yapıştırın:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
        If Target.Value <> "" Then
            Call CommandButton1_Click
        End If
    End If
End Sub

Ardından, CommandButton1_Click prosedürünüzü başka bir modül ya da çalışma sayfasında bırakın. CommandButton1_Click kodunuzun şu şekilde olmalıdır:

Private Sub CommandButton1_Click()
    Dim Sayfa As Worksheet
    Dim Alan As Range
    Dim daralan As Range

    If Cells(2, 9) = "" Then GoTo HATA

    On Error GoTo HATA

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

    saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
    DinamikAlan = "A1:G100" & saydir
    Set Alan = ActiveSheet.Range(DinamikAlan)
    
    Set Sayfa = ActiveSheet

    With Alan
        .Parent.Select
        Set daralan = ActiveCell

        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
            .Introduction = "Merhaba"
            With .Item
                .to = Cells(2, 9)
                .CC = Cells(3, 9)
                .Subject = Cells(1, 9)
                .bcc = "muratgunay48@hotmail.com" 'buraya kullandığınız outlook adresi yazılacak.
                .Send
            End With
        End With

        daralan.Select
    End With
    
    Sayfa.Select

HATA:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[muratgunay48]

Aşağıdaki kodu çalışma sayfasının kod penceresine yapıştırın:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
        If Target.Value <> "" Then
            Call CommandButton1_Click
        End If
    End If
End Sub

Ardından, CommandButton1_Click prosedürünüzü başka bir modül ya da çalışma sayfasında bırakın. CommandButton1_Click kodunuzun şu şekilde olmalıdır:

Private Sub CommandButton1_Click()
    Dim Sayfa As Worksheet
    Dim Alan As Range
    Dim daralan As Range

    If Cells(2, 9) = "" Then GoTo HATA

    On Error GoTo HATA

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

    saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
    DinamikAlan = "A1:G100" & saydir
    Set Alan = ActiveSheet.Range(DinamikAlan)
   
    Set Sayfa = ActiveSheet

    With Alan
        .Parent.Select
        Set daralan = ActiveCell

        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
            .Introduction = "Merhaba"
            With .Item
                .to = Cells(2, 9)
                .CC = Cells(3, 9)
                .Subject = Cells(1, 9)
                .bcc = "muratgunay48@hotmail.com" 'buraya kullandığınız outlook adresi yazılacak.
                .Send
            End With
        End With

        daralan.Select
    End With
   
    Sayfa.Select

HATA:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Teşekkür ederim hocam. Emeğinize sağlık.

 

[muratgunay48]

Aşağıdaki kodu çalışma sayfasının kod penceresine yapıştırın:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
        If Target.Value <> "" Then
            Call CommandButton1_Click
        End If
    End If
End Sub

Ardından, CommandButton1_Click prosedürünüzü başka bir modül ya da çalışma sayfasında bırakın. CommandButton1_Click kodunuzun şu şekilde olmalıdır:

Private Sub CommandButton1_Click()
    Dim Sayfa As Worksheet
    Dim Alan As Range
    Dim daralan As Range

    If Cells(2, 9) = "" Then GoTo HATA

    On Error GoTo HATA

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

    saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
    DinamikAlan = "A1:G100" & saydir
    Set Alan = ActiveSheet.Range(DinamikAlan)
  
    Set Sayfa = ActiveSheet

    With Alan
        .Parent.Select
        Set daralan = ActiveCell

        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
            .Introduction = "Merhaba"
            With .Item
                .to = Cells(2, 9)
                .CC = Cells(3, 9)
                .Subject = Cells(1, 9)
                .bcc = "muratgunay48@hotmail.com" 'buraya kullandığınız outlook adresi yazılacak.
                .Send
            End With
        End With

        daralan.Select
    End With
  
    Sayfa.Select

HATA:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Hocam, şu şekilde sayfa kod alanı oldu. Zamanı yazıp gönder diyorum. Anında gönderiyor. Zamanı girdikten sonra başka bir şey mi yapacağım?
Enter yapsam, TAB yapsam hatta başka hücreye tıklasam mail anında gidiyor.

 

[muhasebeciyiz]

e-posta gönderme işlemi, Worksheet_Change olayında tetikleniyor ve I4 hücresine bir değer girdiğinizde hemen çalışıyor. Eğer bu davranış istemediğiniz bir durumsa, yani hücreye bir değer girdikten sonra başka bir işlem yapmak istemiyorsanız, bunu durdurmanın birkaç yolu var.

Onay Kutusu Ekleyin: Değer girdikten sonra kullanıcının onay vermesi için bir onay kutusu gösterebilirsiniz. Kullanıcı onay vermedikçe e-posta gönderilmeyecek.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
If Target.Value <> "" Then
If MsgBox("E-postayı göndermek istiyor musunuz?", vbYesNo) = vbYes Then
Call CommandButton1_Click
End If
End If
End If
End Sub


Başka Bir Hücreye Tıklayınca E-posta Gönderimi: E-posta gönderme işlemini başka bir hücreye tıklanmasını bekleyerek başlatabilirsiniz. Örneğin, J4 hücresine tıkladığınızda e-posta gönderilsin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
If Target.Value <> "" Then
' Sadece I4 hücresinde bir değer girildiğinde hiçbir şey yapmayın
End If
ElseIf Not Intersect(Target, Me.Range("J4")) Is Nothing Then
If Me.Range("I4").Value <> "" Then
Call CommandButton1_Click
End If
End If
End Sub

 

[muratgunay48]

e-posta gönderme işlemi, Worksheet_Change olayında tetikleniyor ve I4 hücresine bir değer girdiğinizde hemen çalışıyor. Eğer bu davranış istemediğiniz bir durumsa, yani hücreye bir değer girdikten sonra başka bir işlem yapmak istemiyorsanız, bunu durdurmanın birkaç yolu var.

Onay Kutusu Ekleyin: Değer girdikten sonra kullanıcının onay vermesi için bir onay kutusu gösterebilirsiniz. Kullanıcı onay vermedikçe e-posta gönderilmeyecek.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
If Target.Value <> "" Then
If MsgBox("E-postayı göndermek istiyor musunuz?", vbYesNo) = vbYes Then
Call CommandButton1_Click
End If
End If
End If
End Sub


Başka Bir Hücreye Tıklayınca E-posta Gönderimi: E-posta gönderme işlemini başka bir hücreye tıklanmasını bekleyerek başlatabilirsiniz. Örneğin, J4 hücresine tıkladığınızda e-posta gönderilsin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I4")) Is Nothing Then
If Target.Value <> "" Then
' Sadece I4 hücresinde bir değer girildiğinde hiçbir şey yapmayın
End If
ElseIf Not Intersect(Target, Me.Range("J4")) Is Nothing Then
If Me.Range("I4").Value <> "" Then
Call CommandButton1_Click
End If
End If
End Sub

Hocam öncelikle ilginize teşekkür ederim.
Ya ben bir yerde yanlış yapıyorum. 21 Eylül 2024 17.20 yazdım. Onay kutusu ekledim. "Evet" dersen yine anında gönderiyor "Hayır" dersem hiç göndermiyor. Yani ben Excel dosyasını kapatsam 17.20'de mail göndermiyor.
Belki ben yanlış anlattım. Ben I4 hücresine 21 Eylül 2024 17.20 yazacağım ve dosyayı kapatacağım. 17.20'de mail atacak.