Datei öffnen, sobald Änderung bzw. Speichern

Giesarazu · 2013-12-06T09:36:06+00:00

Hallo Forum, auf unserem Server liegt eine Excel-Datei, in der mehrere Personen Einträge vornehmen. Ist es möglich, dass bei einer Person x, sobald eine andere Person eine Änderung vorgenommen und gespeichert hat, diese Datei geöffnet wird, so dass diese Person x die Änderung sofort wahrnimmt ? Alternativ würde es auch reichen, wenn die Datei sich bei Person x öffnet, sobald ein anderer lediglich gespeichert hat (weil man dann ja eine Änderung vermuten darf). Danke für einen Tipp Stefan

Hi,
also doch keine Insellösung :-) zurück zur dynamischeren Variante:
In ein Modul kommt der Code selbst:

Sub SendInfo()
'variablen an das send-Makro übergeben
Dim sText As String
Dim sTo As String
Dim sCC As String
Dim sSubject As String
sTo = "elvis.theking@firmenname.com" 'hier korrekte Mailadresse eintragen!
sCC = "" 'CC, falls gewünscht
sText = "Änderung in " & ActiveWorkbook.Name & ", von " & Environ("UserName") & " um " & Format( _
_
Now, "hh:mm dd.mmm.yy")
sSubject = "Datei wurde geändert: " & ActiveWorkbook.Name
Call SendSheetOutlook(sSubject, sTo, sCC, sText)
End Sub
Private Sub SendSheetOutlook(sSubject As String, sTo As String, sCC As String, sText As String)
Dim olApp         As Object
Dim olOldBody     As String
Set olApp = CreateObject("Outlook.Application")
Application.ScreenUpdating = False
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = sTo
.cc = sCC
.Subject = sSubject
.htmlBody = sText & olOldBody
.Send
End With
Application.ScreenUpdating = True
End Sub

Die Sub "SendSheetOutlook" übernimmt nur das versenden. In der Sub "SendInfo" kannst du die variablen verändern wie du möchtest.
in "ThisWorkbook" kommt dann der "BeforeSave"-Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SendInfo
End Sub

und in die Mappe selbst kommt der Call, wenn in Spalte A etwas geändert wurde:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then SendInfo
End Sub

Du könntest natürlich auf den Umweg über die "SendInfo" Sub verzichten und das Call direkt in die Ereignisroutinen schreiben, aber dann müsstest du bei jeder Änderung an zwei Stellen daran denken den Code zu aktualisieren statt nur bei einer.
Mit dem "onChange" währ ich aber etwas vorsichtig! Irgendein Schlaumeier kommt auf die Idee, "hey ich könnte die 25.000 Einträge in Spalte A doch einfach per Makro in einer Schleife abfrühstücken" und schon beschwert sich der Mailserver-Admin bei dir persönlich ;-)
Abhilfe: Kommentiere die Zeile ".send" aus! Dann wird bei Änderung nur ein Mail erstellt, abgesendet werden muss es dann per Hand.
Grüße,
Klaus M.vdT.

Hi,
Version 2 (nach der wirst du gleich eh fragen):
Modul:

Sub SendInfo(whatInfo As String)
'variablen an das send-Makro übergeben
Dim sText As String
Dim sTo As String
Dim sCC As String
Dim sSubject As String
sTo = "elvis.theking@firmenname.com" 'hier korrekte Mailadresse eintragen!
sCC = "" 'CC, falls gewünscht
sText = "In " & ActiveWorkbook.Name & " hat " & Environ("Username") & " am/um " & Format(Now, (" _
hh:mm dd.mmm.yyyy")) & " " & whatInfo
sSubject = "Datei wurde geändert: " & ActiveWorkbook.Name
Call SendSheetOutlook(sSubject, sTo, sCC, sText)
End Sub
Private Sub SendSheetOutlook(sSubject As String, sTo As String, sCC As String, sText As String)
Dim olApp         As Object
Dim olOldBody     As String
Set olApp = CreateObject("Outlook.Application")
Application.ScreenUpdating = False
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = sTo
.cc = sCC
.Subject = sSubject
.htmlBody = sText & olOldBody
.Send
End With
Application.ScreenUpdating = True
End Sub

Mappe:

Public OldValue As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
Call SendInfo(Target.Address & " verändert von " & OldValue & " auf " & Target.Value & "!")
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
OldValue = ActiveCell.Value
End Sub

ThisWorkbook:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call SendInfo("gespeichert")
End Sub

Das grenzt dann aber schon an verbotener Mitarbeiterüberwachung ;-)
Grüße,
Klaus M.vdT.

Datei öffnen, sobald Änderung bzw. Speichern

Forumthread: Datei öffnen, sobald Änderung bzw. Speichern

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Datei öffnen, sobald Änderung bzw. Speichern

Forumthread: Datei öffnen, sobald Änderung bzw. Speichern

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread