Automatische Email-Problem

Forumthread: Automatische Email-Problem

01.04.2014 11:16:49

Dauergast

Hallo,
ich habe zwar bezüglich meinem Problem mit meiner automatischen Email eine Antwort von Raphael H erhalten, doch habe ich jetzt mir noch etwas anderes überlegt:
https://www.herber.de/bbs/user/89908.xlsm
Hier ist der Code zu den drei Emails hinterlegt, die abgeschickt werden, wenn die Probezeit,Wartefrist oder Befristung "noch 14 Tage" anzeigt.
Raphael H hat mir einen Code geschickt, der die drei Makros zwar zu einem zusammenfasst, aber es werden dennoch 3 Mails (für Probezeit oder Wartefrist oder Befristung)verschickt. Kann man den Code auch so gestalten, dass lediglich eine Email verschickt wird?
Vielen dank schon im Voraus!!

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Automatische Email-Problem

01.04.2014 11:32:32

Rudi
AW: Automatische Email-Problem

01.04.2014 13:50:06

Dauergast
AW: Automatische Email-Problem

01.04.2014 14:15:07

Rudi

AW: Automatische Email-Problem

01.04.2014 11:32:32

Rudi

Hallo,
der die drei Makros zwar zu einem zusammenfasst,
wo ist der?
aber es werden dennoch 3 Mails ...
Es wird doch je Status eine veschickt.
Was willst du genau?
Gruß
Rudi

AW: Automatische Email-Problem

01.04.2014 13:50:06

Dauergast

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

AW: Automatische Email-Problem

01.04.2014 14:15:07

Rudi

Hallo,
kann dein Problem nicht sehen.
Was willst du genau?
Code würde ich eher so schreiben:

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

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: Automatische Email-Problem

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread