Automatische Email-Problem

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
das wäre der Code, der die drei Makros zu einem zusammenfasst:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row > 1 Then
If .Column = 18 Or .Column = 23 Or .Column = 27 Then
Call Mail_senden(Target.Column, Target.Row)
End If
End If
End With
End Sub

Sub Mail_senden(Spalte As Long, Zeile As Long)
Dim outl
Dim Mail As Object
Dim Datenblatt As Worksheet
Dim subText As String
Dim bodyText As String
Dim toText As String
Set Datenblatt = ThisWorkbook.Sheets("Datenblatt")
Select Case Spalte
Case Is = 18
If Datenblatt.Cells(Zeile, Spalte) = "noch 14 Tage" And Datenblatt.Cells(Zeile, Spalte + _
2) = "" Then
subText = "Erinnerung probezeit"
bodyText = "Die Probezeit von " & Datenblatt.Cells(Zeile, Spalte - 17).Text & " lä _
uft in 14 Tagen ab"
toText = Datenblatt.Cells(Zeile, Spalte + 1).Text
Else: Exit Sub
End If
Case Is = 23
'Dein Abfrage
Case Is = 27
'Dein Abfrage
End Select
Set outl = CreateObject("Outlook.Application")
Set Mail = outl.CreateItem(0)
With Mail
.Subject = subText
.body = bodyText
.to = toText
.send
End With
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
With WshShell
.AppActivate outl
.SendKeys ("")
End With
Set Mail = Nothing
Set outl = Nothing
Set WshShell = Nothing
Datenblatt.Cells(Zeile, Spalte + 2) = "Mail gesendet"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count = 1 Then If .Row > 1 Then Select Case .Column Case 18, 23, 27 Mail_senden Target End Select End If End If End With End Sub Sub Mail_senden(rng As Range) Dim oOutLook Dim oMail As Object Dim subText As String Dim bodyText As String Dim toText As String If rng = "noch 14 Tage" And rng.Offset(, 2) = "" Then Select Case rng.Column Case 18 subText = "Probezeit" Case 23 subText = "Wartefrist" Case 27 subText = "Befristung" End Select End If If subText "" Then bodyText = _ "Die " & subText & " von " _ & rng.Offset(, -rng.Column + 1) _ & " läuft in 14 Tagen ab." toText = rng.Offset(, 1) subText = "Erinnerung " & subText Set oOutLook = CreateObject("Outlook.Application") Set oMail = oOutLook.CreateItem(0) With oMail .Subject = subText .body = bodyText .to = toText .send End With rng.Offset(, 2) = "Mail gesendet" 'wozu? 'Dim WshShell ' Set WshShell = CreateObject("WScript.Shell") ' With WshShell ' .AppActivate outl ' .SendKeys ("") ' End With Set oMail = Nothing Set oOutLook = Nothing 'Set WshShell = Nothing End If End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread