Readdy Write

Excel Vorlage: Automatisch eine Email versenden bei einer bestimmten Eingabe in Excel

05.09.2018 (👁5265)

https://codedocu.de/Details?d=2630&a=8&f=413&l=0

Das folgende Excel Dokument versendet automatisch eine Email wenn in einem Eingabebereich ein bestimmter Wert eingegeben wird.

Wenn in der Eingabespalte B:B ein Wert wie Test… eingegeben wird, dann wird automatisch über Outlook eine Standard-Email gesandt.

Man kann die Excel-Datei anpassen, indem man in Excel mit Alt-F11 in der vba Makro-Code Seite die Einstellungen anpasst.

Vba Code

Notwendiger vba Makro Code in Excel

Unter Alt-F11 im Excel Document

Die Adresse und den Text kann man im Kopfbereich einstellen

'-----< Setup >------

Private Const °Input_Check As String = "Test*"

 

Private Const °Email_Address_To As String = "raimund.popp@codedocu.de"

Private Const °Email_Title As String = "Test Automatische Email bei Excel-Eingabe"

Private Const °Email_Text As String = "This is Email-Text"

'-----</ Setup >------

Option Explicit On

 

'-----< Setup >------

Private Const °Input_Check As String = "Test*"

 

Private Const °Email_Address_To As String = "raimund.popp@codedocu.de"

Private Const °Email_Title As String = "Test Automatische Email bei Excel-Eingabe"

Private Const °Email_Text As String = "This is Email-Text"

'-----</ Setup >------

 

 

'==================< Events >==================

Private Sub Worksheet_Change(ByVal Target As Range)

    '--------< Worksheet_Change(ImputCell) >--------

    '*After_Cell_Input_Change

    If Not Intersect(Target, Range("B:B")) Is Nothing Then

        If Target.Value Like °Input_Check Then

            Dim sText As String

            sText = °Email_Text

            sText = sText & vbCrLf & "Eingabewert =" & Target.Value & " in Zeile: " & Target.Address

            Send_Email(sText)

        End If

    End If

    '--------</ Worksheet_Change(ImputCell) >--------

End Sub

'==================</ Events >==================

 

 

 

'==================< Functions >==================

Private Sub Send_Email(ByVal sText As String)

    '-------------< Send_Email() >-------------

    '----< Send with Outlook >----

    Dim app_Outlook As Outlook.Application

    Set app_Outlook = New Outlook.Application

   

    '--< Email einstellen >--

    Dim objEmail As Outlook.MailItem

    

    '--< Send Email >--

    Set objEmail = app_Outlook.CreateItem(olMailItem)

    objEmail.To = °Email_Address_To

    objEmail.Subject = °Email_Title

    objEmail.Body = sText

    objEmail.Display False

    objEmail.Send   '*optional

    '--</ Send Email >--

        

    

    '< Abschluss >

    Set objEmail = Nothing

    Set app_Outlook = Nothing

    '</ Abschluss >

        

    '----</ Send with Outlook >----

    '-------------</ Send_Email() >-------------

End Sub

 

'==================</ Functions >==================

 

 

 


0,00 €