Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1352to1356
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatisch Email verschicken

Automatisch Email verschicken
28.03.2014 14:13:44
Dauergast
Hallo,
ich habe noch folgendes Problem in der Mappe:https://www.herber.de/bbs/user/89908.xlsm
Ich habe hier drei Makros hinterlegt, die im Prinzip alles das gleiche machen...Wechselt der Status der Probezeit oder der Wartefrist oder der Befristung auf den Status "noch 14 Tage", dann wird automatisch eine Email mit dem jeweiligen Text versendet. Ist es denn auch möglich, die drei Makros zu einem zusammen zufassen?
Wie müsste ich dazu den Code umschreiben?
Vielen Dank schon im Voraus!!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatisch Email verschicken
28.03.2014 22:09:38
Raphael
Hallo Dauergast,
Namen sind zwar eindeutig besser als bezeichnende Nomen und erhöhen die Antwortchance um gute 100%, aber lassen wir das.
Ja du kannst aus diesen 3 Subs auch eine machen.
Zum Beispiel so oder ähnlich:

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
Gruess
Raphael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige