Sicherheitsrechte - Zellenbezogene Emails

Hallo zusammen,
sry für das nicht wirklich vielaussagende Topic!
Ich habe eine Urlaubstabelle (siehe link):

Die Datei https://www.herber.de/bbs/user/28976.xls wurde aus Datenschutzgründen gelöscht

Wenn jetzt ein MA irgendwo "Urlaub" einträgt möchte ich das eine email an den Vertreter gesendet wird.
Hier steht drin:
"MA1 möchte an diesem Tag "xy" Urlaub nehmen. Sind sie damit einverstanden?"
"Ja" "Nein"
Hat er dies getan wird eine Email an eine 3. Person geschickt welche Benachrichtigt wird das der Urlaub genehmigt ist. Wurde er abgelehnt geht eine Mail an den Urlaubssteller zurück mit der Info der ablehnung.
Ist das Grundsätzlich möglich? Wenn ja ... hat jemand ein paar gute Tipps wie das realisierbar wäre ?! Das Thema ist noch nicht ausgereift aber grundsätzlich wollte ich wissen ob diese Idee realisierbar ist ?
Ich freue mich auf eure zahlreichen Ideen.
Vielen Dank und freundlichen Gruß
Andre Schulz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Andre,
Datei:

Die Datei https://www.herber.de/bbs/user/29030.xls wurde aus Datenschutzgründen gelöscht

hat nacchfolgenden Code. Sind noch Bugs drinnen, also der Name wird nicht gefunden, aber wird schon werden.
Eventuell :-)
Gruß
Reinhard
ps:Das Forum lebt auch von Rückmeldungen

'Option Explicit
Sub EmailErzeugen()
Set ws2 = Worksheets("Tabelle2")
Set ws3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
For Each Zelle In .Cells
If Zelle = "Urlaub" Then
If ws3.Range(Zelle.Address) <> "g" Then
Betreff = "Bitte um Urlaubsvertretung"
If finden(Cells(Zelle.Row, 6), 2) = "Fehler" Then GoTo Fehler
Anrede = finden(Cells(Zelle.Row, 6), 2)
Vorname = finden(Cells(Zelle.Row, 6), 3)
Nachname = finden(Cells(Zelle.Row, 6), 4)
Vertreter = finden(Cells(Zelle.Row, 6), 5)
Eadresse = finden(Cells(Zelle.Row, 6), 7)
Inhalt = "Sehr geehrte "
If finden(Cells(Zelle.Row, 6), 6) = "m" Then Inhalt = Inhalt & "r"
Inhalt = Inhalt & Vertreter & "," & Chr(10)
Inhalt = Inhalt & Anrede & " " & Vorname & " " & Nachname & " "
Inhalt = Inhalt & "bittet um Urlaubsvertretung für den " & Cells(Zelle.Row, 2)
Call EmailSenden
ws3.Range(Zelle.Address) = "g"
End If
End If
Next Zelle
End With
Exit Sub
Fehler:
MsgBox "Namen nicht efunden"
End Sub
Sub EmailSenden()
End Sub
Function finden(Such As String, Spalte As Integer) As String
On Error GoTo Fehler
finden = Application.WorksheetFunction.VLookup(Such, Worksheets("Tabelle2").Range("A2:F10)"), Spalte, 0)
Exit Function
Fehler:
finden = "Fehler"
End Function

'Option Explicit Sub EmailErzeugen() Set ws2 = Worksheets("Tabelle2") With Worksheets("Tabelle1") For Each Zelle In .UsedRange.Cells If Zelle = "Urlaub" Then If Zelle.Font.ColorIndex <> 34 Then Betreff = "Bitte um Urlaubsvertretung" If finden(Cells(6, Zelle.Column), 2) = "Fehler" Then GoTo Fehler Anrede = finden(Cells(6, Zelle.Column), 2) Vorname = finden(Cells(6, Zelle.Column), 3) Nachname = finden(Cells(6, Zelle.Column), 4) Vertreter = finden(Cells(6, Zelle.Column), 5) Eadresse = finden(Cells(6, Zelle.Column), 7) Inhalt = "Sehr geehrte " If finden(Cells(6, Zelle.Column), 6) = "m" Then Inhalt = Inhalt & "r" Inhalt = Inhalt & Vertreter & "," & Chr(10) Inhalt = Inhalt & Anrede & " " & Vorname & " " & Nachname & " " Inhalt = Inhalt & "bittet um Urlaubsvertretung für den " & Cells(Zelle.Row, 2) Call EmailSenden Zelle.Font.ColorIndex = 5 End If End If Next Zelle End With Exit Sub Fehler: MsgBox "Namen nicht efunden" End Sub Sub EmailSenden() MsgBox "huhu" End Sub Function finden(Such As String, Spalte As Integer) As String On Error GoTo Fehler finden = Application.WorksheetFunction.VLookup(Such, Worksheets("Tabelle2").Range("A2:F10"), Spalte, 0) Exit Function Fehler: finden = "Fehler" End Function

'Option Explicit Sub EmailErzeugen() Set ws2 = Worksheets("Tabelle2") With Worksheets("Tabelle1") For Each Zelle In .UsedRange.Cells If Zelle = "Urlaub" Then If Zelle.Font.ColorIndex <> 5 Then Betreff = "Bitte um Urlaubsvertretung" If finden(Cells(6, Zelle.Column), 2) = "Fehler" Then GoTo Fehler Anrede = finden(Cells(6, Zelle.Column), 2) Vorname = finden(Cells(6, Zelle.Column), 3) Nachname = finden(Cells(6, Zelle.Column), 4) Vertreter = finden(Cells(6, Zelle.Column), 5) Eadresse = finden(Cells(6, Zelle.Column), 7) MsgBox Eadresse Inhalt = "Sehr geehrte " If finden(Cells(6, Zelle.Column), 6) = "m" Then Inhalt = Inhalt & "r" Inhalt = Inhalt & Vertreter & "," & Chr(10) Inhalt = Inhalt & Anrede & " " & Vorname & " " & Nachname & " " Inhalt = Inhalt & "bittet um Urlaubsvertretung für den " & Cells(Zelle.Row, 2) Call EmailSenden(Eadresse, Betreff, Inhalt) Zelle.Font.ColorIndex = 5 End If End If Next Zelle End With Exit Sub Fehler: MsgBox "Namen nicht gefunden" End Sub Sub EmailSenden(ByVal Eadresse As String, ByVal Betreff As String, ByVal Inhalt As String) MsgBox Eadresse & " " & Betreff & " " & Inhalt End Sub Function finden(Such As String, Spalte As Integer) As String On Error GoTo Fehler finden = Application.WorksheetFunction.VLookup(Such, Worksheets("Tabelle2").Range("A2:F10"), Spalte, 0) Exit Function Fehler: finden = "Fehler" End Function

Beliebteste Forumthreads (12 Monate)

Sicherheitsrechte - Zellenbezogene Emails

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread