Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1052to1056
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

E-Mail Benachrichtigung

E-Mail Benachrichtigung
25.02.2009 08:48:43
Jessi
Hallo zusammen,
habe von Klaus K. einen Code hier gefunden, der auch einwandfrei funktioniert.
Es geht darum eine E-Mail automatisch zu erstellen, wenn ein bestimmter Wert erreicht ist.
Dieser Wert ist jetzt bei diesem Code in der Zelle A1 einer Tabelle1.
Ich habe allerdings eine Tabelle, wo eine komplette Spalte nach Datum durchgeschaut werden soll, wenn da noch 2 Tage bis zum Soll-Datum (aus Spalte) sein soll, dann soll der Code ausgeführt werden.
Wer hat eine Idee?
LG
Jessi

Private Sub Worksheet_Change(ByVal Target As Range)
'Es wird nur die Zelle A1 in dieser Tabelle geprüft
'Erst prüfen ob Zelle A1 gemeint ist
If Target.Cells.Address = "$A$1" Then
'Deklarieren
Dim zw As String
zw = Range("A1").Value 'Wert aus Zelle A1 in Variable "zw" einlesen
If zw >= 100 Then
'Wenn zw (also Zelle A1) grösser oder gleich 100 ist, dann weiter
'Deklarieren
Dim oOL As Object
Dim oOLMsg As Object
Dim oOLAttach As Object
Dim sTo As String
Dim sSubject As String
Dim sBody As String
sTo = "eMail@Adresse.de"
sSubject = "Stückzahl wurde erreicht"
sBody = "Es wurden " & zw & " Stück erreicht"
'###### Mit Outlook senden ######
Set oOL = CreateObject("Outlook.Application")
Set oOLMsg = oOL.CreateItem(0)
With oOLMsg
.To = sTo 'Empfänger
.Subject = sSubject 'Betreffzeile
.Body = sBody 'Text
.Importance = 2 '1 ist "Normal" und 2 ist "Wichtig"
.display '"display" ist zum anschauen, mit "Send" wird gesendet
End With
End If
End If
End Sub


'Die güne Schrift ist nur zur Erklärung und kann gelöscht werden

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Keine Idee, ohne Beispielmappe! (owT)
25.02.2009 08:52:13
Renee

Upload :-) Sorry...
25.02.2009 09:10:33
Jessi
https://www.herber.de/bbs/user/59750.xls
hier noch die Erklärung für den blauen Bereich:
so in etwa sieht die Konstellation meiner Tabelle aus, eigentlich ist es eine Tabelle, die wichtigen Schriftverkehr (Rückantwort auf Schreiben) mit darstellt, aber nebenbei noch jede Menge anderer Informationen beinhaltet. Mir geht es im wesentlichen hier einfach um die Frage wie ich sowas einbauen kann. Spalten kann ich ja selbst anpassen, das bekomme ich mit meinen VBA Kenntnissen hin.
Es sind Vertragstermine für Rückantworten, die erstellt werden müssen.
Bin für jeden Hilfeversuch dankbar!
LG
Jessi
Anzeige
AW: Upload :-) Sorry...
25.02.2009 09:23:19
Renee
Hi Jessi,
Deine Angaben in der Tabelle sind ungefähr gleich dürftig, aber OK da du ja VBA Erfahrung hast:
Als Beispiel: Änderungen in Spalte B lösen Trigger aus, Prüfung von Zellen in Spalte A
1. In der Routine den Target.Bereich auf die Spalte die geändert werde darf und den Trigger auslösen soll einschränken:

If Intersect(Target, Range("B:B")) Is Nothing _
Or Target.Count > 1 Then Exit Sub
... Code Überprüfung...


2. Überprüfung in einer Range statt nur in einer Zelle


Dim rC as Range
For each rC in Range("A:A")
If rC = Bedingung Then
 ...Code für das Versenden der Email...
End if
Next rC 


GreetZ Renée

Anzeige
AW: Upload :-) Sorry...
25.02.2009 09:40:33
Jessi
hallo renée,
nein es würde nur darum gehen das Systemdatum als Ist-Datum zu hinterlegen und mit dem Soll-Datum (in der Spalte J) zu vergleichen. Wenn überfällig, soll E-Mail Prozedur ausgeführt werden und Verteilerkreis als E-Mail Empfänger (s. Spalte I) erfolgen. Vielleicht mit 2 Tagen Vorlauf um das Schriftstück auch noch zu erstellen.
Mit dem Code kann ich nicht direkt was anfangen...Leider :-( VBA habe ich nur Grundkenntnisse.
LG
Na dann halt vielleicht so...
25.02.2009 11:00:18
Renee
Hi Jessi,
Lösch den Code im Tabelleblatt Worksheet_Change.
Diesen Code in ein Modul (und als Makro aufrufen):

Sub VerfallPrüfen()
Const ctTabellenName = "Tabelle1"
Const ctSpaltePrüfen = "J"
Const ctSpalteErledigt = "K"
Const ctSpalteBetreff = "B"
Const ctSpalteEmpfänger = "I"
Dim lRow As Long
Dim bDoCheck As Boolean
Dim objApp As Object
Dim objMailItm As Object
Set objApp = CreateObject("Outlook.Application")
lRow = 4
bDoCheck = True
Do While bDoCheck
With Sheets(ctTabellenName)
If .Cells(lRow, ctSpaltePrüfen) = Date And _
.Cells(lRow, ctSpalteErledigt)  "erledigt" Then
Set objMailItm = objApp.CreateItem(0)
objMailItm.To = .Cells(lRow, ctSpalteEmpfänger)
objMailItm.Subject = .Cells(lRow, ctSpalteBetreff)
objMailItm.Body = "Was immer als Mailtext!"
objMailItm.Send
Set objMailItm = Nothing
.Cells(lRow, ctSpalteErledigt) = "erledigt"
End If
lRow = lRow + 1
bDoCheck = Not (IsEmpty(.Cells(lRow, ctSpaltePrüfen)))
End With
Loop
Set objApp = Nothing
End Sub


GreetZ Renée

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige