Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

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

05.09.2018 (­čĹü199)

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 >==================