Hallo Robin,
hier mal der Code von Torsten angepasst:
Option Explicit
Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim objOL As Object, objMail As Object, strMsg As String
Dim strAdr As String, Zelle As Range, loLetzte As Long
Set objOL = CreateObject("outlook.application")
Set objMail = objOL.createItem(0)
strMsg = "Datei " & Me.Name & " wurde am " & Format(Date, "dd.MM.yyyy") & " um " _
& Format(Now, "hh:mm:ss") & " geändert." & vbCrLf
With Worksheets("Mail-Adressen")
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each Zelle In .Range(.Cells(2, "A"), .Cells(loLetzte, "A"))
If Zelle.Value <> "" Then
If InStr(Zelle.Value, "@") > 0 Then
If UCase(Zelle.Offset(, 1)) = "X" Then
If strAdr = vbNullString Then
strAdr = Zelle.Value
Else
strAdr = strAdr & ";" & Zelle.Value
End If
End If
End If
End If
Next Zelle
End With
If Not strAdr = vbNullString Then
With objMail
.To = strAdr
.CC = ""
.BCC = ""
.Subject = "Datei xx wurde aktualisiert"
.Body = strMsg
.HTMLBody = strMsg & _
"<a href=""file://" & ActiveWorkbook.Path & """>Laufwerk</a>"
.send
End With
Else
MsgBox "Fehler: Es wurde kein E-Mail Empfänger ausgewählt."
End If
Set objMail = Nothing: Set objOL = Nothing
End Sub
Blattname mit deinen Mail-Empfängern = Mail-Adressen
Mail-Adressen stehen in Spalte A, beginnend ab A2, in A1 Überschrift
Auswahl der jeweiligen Mail-Adresse durch setzen eines x in Spalte B
Gruß Werner
|