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.