Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1340to1344
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1340to1344
1340to1344
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datei öffnen, sobald Änderung bzw. Speichern

Datei öffnen, sobald Änderung bzw. Speichern
06.12.2013 09:36:06
Giesarazu
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

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

Betreff
Datum
Anwender
Anzeige
AW: Datei öffnen, sobald Änderung bzw. Speichern
06.12.2013 09:47:19
Klaus
Hallo Stefan,
NEIN.
Alternative: per VBA Before-Save eine Mail schicken, oder einen Messenger anstoßen oder sowas.
Grüße,
Klaus M.vdT.

AW: Datei öffnen, sobald Änderung bzw. Speichern
06.12.2013 10:07:11
Giesarazu
Hi Klaus,
besten Dank ! Diese Lösung wäre ebenso gut !!! Ähm, den Code dafür könnte ich auch irgendwo
hier finden bzw. weisst du, wenn ich mal bescheiden dreist fragen dürfte, wie der ungefähr aussehen
muss ? Wir setzen hier Outlook 2010 ein. Meine VBA-Kenntnisse sind doch eher bescheiden..
Nochmals vielen Dank
Stefan

AW: Datei öffnen, sobald Änderung bzw. Speichern
06.12.2013 10:20:58
Klaus
Hi,
in "diese Arbeitsmappe":
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SendInfo
End Sub
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
Grüße,
Klaus M.vdT.

Anzeige
oder kürzer so:
06.12.2013 10:26:38
Klaus
Hallo Stefan,
oder so: 
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
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 = "elvis.theking@firmenname.com" 'hier korrekte Mailadresse eintragen!
.cc = "" 'CC, falls gewünscht
.Subject = "Datei wurde geändert: " & ActiveWorkbook.Name
.htmlBody = "Änderung in " & ActiveWorkbook.Name & ", von " & Environ("UserName") & _
" um " & Format(Now, "hh:mm dd.mmm.yy") & olOldBody
.Send
End With
Application.ScreenUpdating = True
End Sub
etwas kürzer, da komplett undynamisch und auf dein Problem zugeschneidert - sozusagen die Insellösung :-) Vielleicht ist dir das ja lieber.
Grüße,
Klaus M.vdT.

Anzeige
AW: oder kürzer so:
06.12.2013 10:35:23
Giesarazu
wow, phantastisch !!!!
Herzlichen Dank, das ist große Kunst (jedenfalls für mich) !
Werde es mit Vergnügen testen !
Stefan

mit Bravour gelöst !!!!
06.12.2013 10:49:50
Giesarazu
das geht ja ab wie Schmitt's Katze !!!!
super Lösung, heute gibts ne Feier !!!
1000 Dank nochmals :)

Danke für die Rückmeldung! m.T.
06.12.2013 10:55:14
Klaus
Freut mich geholfen zu haben! An dieser Stelle Danke ich dem Fourmsuser "Mumpel", von dem ich den Originalcode übernommen habe.
Grüße,
Klaus M.vdT.

AW: Danke für die Rückmeldung! m.T.
06.12.2013 12:48:21
Giesarazu
Jau, hat sehr geholfen u. is praxistauglich. Klaus, noch eine letzte Zusatzfrage: Ginge eine Versendung auch dann, wenn eine Änderung in der Spalte A erfolgt. Also immer dann ,wenn irgendeine Zelle in der Spalte A geändert wird, soll eine Mail versandt werden ? Müsste dann ja irgendwas wie folgt sein:
Private Sub Worksheet_Change(ByVal Target As Range)
If ? target oder intersect ? Then
Set olApp...

Anzeige
Also doch variabel :-)
06.12.2013 13:38:33
Klaus
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.

Anzeige
coolere Version :-)
06.12.2013 13:53:37
Klaus
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.

Anzeige
AW: coolere Version :-)
06.12.2013 14:28:03
Giesarazu
Altobelli, is ja harter Toback !!!
Ich kanns leider erst am Montag inna Firma prüfen
Viiiielen Dank für die Mühe, echt sehr nett !!!

AW: Also doch variabel :-)
09.12.2013 10:12:55
Giesarazu
so, jetzt ist alles drin und läuft !!! die totale Überwachung habe ich nicht gewählt, die andere Variante reicht vollkommen aus ;) Also nochmals herzlichen Dank für die tolle Unterstützung !!!!!!!
Stefan

Danke für die Rückmeldung! owT.
09.12.2013 11:09:51
Klaus
.

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige