Auto.Benachrichtigung wenn E.Datei sich ändert .
02.02.2007 09:30:02
Wolfgang
habe noch mal den Vorgang vom 24.01 8:43 eingestellt.
Matthias hat mir schon sehr geholfen, aber irgendwie läufts nicht so recht.
Hallo Wolfgang,
Hier die Datei, etwas verkürzt wegen der 300kb halt.
https://www.herber.de/bbs/user/40085.xls
erstmal würde ich die Tabelle so ändern:
Tabelle hab ich sohon geändert, WOLFGANG
Dann muss sichergestellt sein, dass in Zeile 1 der entsprechenden Spalte eine "1" eingetragen wird, wenn sich eine Tabelle ändert. Dazu ins Modul "ThisWorkbook":
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range
With Sheets("Verteiler für Makro don't Touch")
Set rng = .Range("D2:M2").Find(What:=Sh.Name, LookAt:=xlWhole)
If Not rng Is Nothing Then rng.Offset(-1, 0) = 1
End With
End Sub
Dann muss die BeforeClose-Prodezur noch folgendenmaßen geändert werden:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'wird nur gesendet, wenn seit letztem Speichern Änderungen in Datei vorgenommen wurden
If MsgBox("Soll der Verteiler über die Änderung informiert werden?", vbQuestion + vbYesNo, "Nachfrage") = vbYes Then
'MsgBox fragt nach ob Verteiler informiert werden soll
If ThisWorkbook.Saved Then
Dim MailDoc As Object, OutApp As Object
'Set OutApp = CreateObject("Notes.Application")'
Set LNSession = CreateObject("Notes.NotesSession")
Set LNDb = LNSession.GetDatabase("", "")
If LNDb.IsOpen = True Then
'Already open for mail
Else
LNDb.OPENMAIL
End If
Set MailDoc = LNDb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.Subject = "Meldung von Excel " & Date & " " & Time
MailDoc.Body = "Das Dokument hat sich geändert." & vbCrLf & "Ihr findet das Dokument auf Laufwerk S" & vbCrLf & "Files."
MailDoc.send 0, Empfaenger 'siehe neue Funktion!!
Set LNSession = Nothing
Set LNDb = Nothing
Set MailDoc = Nothing
End If
End If
'Änderungsmarkierungen löschen und nochmal speichern
With Sheets("Verteiler für Makro don't Touch")
If WorksheetFunction.CountA(.Range("D1:M1")) > 0 Then
.Range("D1:M1").ClearContents
Me.Save
End If
End With
End Sub
Die o.g. Prozedur verwendet die Funktion "Empfaenger()", welche die zu Benachrichtigenden Personen in einem Array wiedergibt:
Function Empfaenger()
Dim rng As Range, z As Range, kette As String
'Bereich, in dem die Empfängernamen stehen:
Set rng = Sheets("Verteiler für Makro don't Touch").Range("C3:C37")
For Each z In rng
If z.Value "" Then kette = kette & z.Value & ","
Next z
'letztes Komme entfernen:
kette = Left(kette, Len(kette) - 1)
'in Array wandeln:
Empfaenger = Split(kette, ",")
End Function
Anmerkung: hier werden viele absolute Werte verwendet (Name des Tabellenblattes, Bereiche, in denen die Zuordnungen stehen... Ich empfehle die, diese Werte als globale Konstanten zu definieren, so dann du sie bei einer Änderung nur einmal in Code anpassen musst.
Viel Erfolg,
Matthias