Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1144to1148
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
Inhaltsverzeichnis

Schreibschutz / Speicherschutz

Schreibschutz / Speicherschutz
Pasi
Hallo zusammen. Ich würde mich freuen wenn mir mal wieder jemand von euch bei einem kleinen Problem weiterhelfen könnte.
Ich habe eine Exceldatei die von verschiedenen Leuten (schreibend oder lesend) geöffnet wird. Jetzt möchte ich in einem seperaten Sheet eine Liste führen wer sich wann eingelogt hat. Dazu habe ich im Workbook_Open folgenden Code eingefügt.
Private Sub Workbook_Open()
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
'Ermitteln User
Worksheets("Userübersicht").Visible = True
Dim UserName As String
Dim ReiheUser As String
Dim Netzwerk As Object
Dim AnzahlUser As String
If Not ActiveWorkbook.ReadOnly Then
Set Netzwerk = CreateObject("wscript.network")
UserName = Netzwerk.UserName
Sheets("Userübersicht").Select
Cells(1, 2).Select
AnzahlUser = Selection.Value
Cells(AnzahlUser + 1, 1).Select
Selection = UserName
Cells(AnzahlUser + 1, 2).Select
Selection.Value = Date
Cells(AnzahlUser + 1, 1).Select
AnzahlUser = AnzahlUser + 1
Cells(1, 2).Select
Selection = AnzahlUser
Sheets("Montageplanung").Select
End If
Das funktioniert auch ganz wunderbar, solange der angemeldete User sich schreibend anmeldet. Wählt er sich nur mit Lesezugriff ein bekomme ich Probleme. Ich dachte ich ergänze eine zweite If-Funktion wie folgt:
If ActiveWorkbook.ReadOnly Then
Set Netzwerk = CreateObject("wscript.network")
' MsgBox Netzwerk.Computername
UserName = Netzwerk.UserName
Sheets("Userübersicht").Select
Cells(1, 2).Select
AnzahlUser = Selection.Value
Cells(AnzahlUser + 1, 1).Select
Selection = UserName
Cells(AnzahlUser + 1, 2).Select
Selection.Value = Date
Cells(AnzahlUser + 1, 1).Select
AnzahlUser = AnzahlUser + 1
Cells(1, 2).Select
Selection = AnzahlUser
Sheets("Montageplanung").Select
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True
ActiveWorkbook.Save
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=False
End If
If ActiveWorkbook.ReadOnly Then
Application.CommandBars("Standard").Controls("&Speichern").Enabled = False
Application.CommandBars("Worksheet Menu Bar").Controls("&Datei").Controls("&Speichern").Enabled = False
Application.CommandBars("Worksheet Menu Bar").Controls("&Datei").Controls("&Speichern unter...").Enabled = False
End If
Ich dachte über die Funktion am Schluss könnte ich den Schreibschutz aufheben (klappt auch) speichern und dann wieder setzen. Genau das klappt aber nicht. Eigentlich habe ich auch über Application.CommandBars, etc. jedes speichern von Kopien unterbunden. Das alles funktioniert aber nicht mehr wenn ich die letzten drei Zeilen aktiviere.
Würde mich freuen wenn jemand einen Tipp hat
MfG Pasqual

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Schreibschutz / Speicherschutz
16.03.2010 09:45:47
PointOfView
Hallo Pasqual,
ich erzeuge eine externe Textdatei in die das ein- und ausloggen protokolliert wird. Hierbei ist es dann auch egal, ob schreibgeschützt oder nicht.
Schreibe in "DeineArbeitsmappe":
Dim AppObject As New CAppLog
Private Sub Workbook_Open()
'Einloggen Protokollieren
Set AppObject.app = Application
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Ausloggen protokollieren
Set AppObject.app = Application 'Nothing
Application.DisplayAlerts = True
ThisWorkbook.Saved = True
End Sub
Lege nun ein Klassenmodul mit den Namen "CAppLog" an:
Public WithEvents app As Application

Private Sub app_WorkbookOpen(ByVal WBook As Excel.Workbook)
sUser = Environ("username")
sComputer = Environ("computername")
Benutzer = Application.UserName
Datum = Format(Now, "dd.mm.yyyy")
Uhrzeit = Format(Now, "HH:MM")
DateiName = WBook.fullname
Open "\\Gtsv04\as 400 abfragen\AS400_Abfragen_Quelldokumente\Log-Datei\"DeinDateiname". _
txt" For Append As #1
Print #1, Benutzer & vbTab & "Netzwerkname " & sUser & vbTab & sComputer & vbTab &  _
Datum & vbTab & Uhrzeit _
& vbTab & DateiName
Close #1
End Sub

Private Sub App_WorkbookBeforeClose(ByVal WBook As Workbook, _
Cancel As Boolean)
sUser = Environ("username")
sComputer = Environ("computername")
Benutzer = Application.UserName
Datum = Format(Now, "dd.mm.yyyy")
Uhrzeit = Format(Now, "HH:MM")
DateiName = WBook.fullname
Open "\\Gtsv04\as 400 abfragen\AS400_Abfragen_Quelldokumente\Log-Datei\"DeinDateiname". _
txt" For Append As #2
Print #2, Benutzer & vbTab & "Netzwerkname " & sUser & vbTab & sComputer & vbTab &  _
Datum & vbTab & Uhrzeit _
& vbTab & "Aus Datei geloggt"
Close #2
End Sub
Viele Grüsse
Oliver
PointOfView
Anzeige
AW: Schreibschutz / Speicherschutz
16.03.2010 12:04:35
fcs
Hallo Pasqual,
als Alternative zu Olivers Vorschlag, das Öffnen der Datei in eine Textdatei zu schreiben (was wesentlich schneller funktioniert) kann man die Informationen auch in eine externe Exceldatei schreiben, die beim Öffnen der Arbeitsmappe kurzzeitig geöffnet wird.
Hier ein Bespiel, wobei die Log-Datei angelegt wird, wenn sie im Verzeichnis der Datei noch nicht vorhanden ist.
Gruß
Franz
'Erstellt/angepasst unter Excel 2007
Private Sub Workbook_Open()
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Dim UserName As String
Dim ReiheUser As String
Dim Netzwerk As Object
Dim AnzahlUser As String
Dim wbUser As Workbook, wksUser As Worksheet, sFilename
sFilename = ThisWorkbook.Path & Application.PathSeparator & "UserUebersicht" & ThisWorkbook. _
Name
'Prüfen, ob Datei mit Userliste schon existiert
If Dir(sFilename, vbHidden) = "" Then
'Datei neu anlegen
Set wbUser = Workbooks.Add(Template:=xlWBATWorksheet)
With wbUser.Worksheets(1)
.Name = "Info"
.Cells(4, 1) = "Diese Arbeitsmappe enthält Informationen zu den Useranmeldungen für Datei: _
.Cells(5, 1) = ThisWorkbook.FullName
.Protect
End With
wbUser.Worksheets.Add after:=Sheets(1)
With wbUser.Worksheets(2)
'Titelzeilen eintragen und Zellen/Spalten formatieren
.Name = "Userübersicht"
.Cells(1, 1) = "Anzahl User"
.Cells(1, 2) = 0
.Cells(2, 1) = "User Name"
.Columns(1).ColumnWidth = 20
.Cells(2, 2) = "Datum"
.Columns(2).NumberFormat = "DD.MM.YYYY"
.Cells(1, 2).NumberFormat = "0"
.Cells(2, 3) = "UhrZeit"
.Columns(3).NumberFormat = "hh:mm:ss"
.Cells(2, 4) = "Schreiben/Lesen"
Cells(3, 1).Select
ActiveWindow.FreezePanes = True 'Fenster fixieren unter Titelzeilen
.Visible = xlSheetHidden 'Blatt ausblenden
End With
'Datei mit Schreib-Kennwort("Test") im Format Excel8 speichern _
(alternativ xlWorkbookNormal oder xlWorkbookDefault verwenden)
wbUser.SaveAs Filename:=sFilename, FileFormat:=xlExcel8, Password:="", _
writerespassword:="Test", ReadOnlyRecommended:=True, addtomru:=False
Else
'Datei Attribut Schreibgeschützt zurücksetzen
VBA.FileSystem.SetAttr sFilename, vbNormal
'Datei mit Userinfos öffnen
Set wbUser = Workbooks.Open(Filename:=sFilename, ReadOnly:=False, _
ignorereadonlyrecommended:=True, Password:="", writerespassword:="Test")
End If
'Userinfos eintragen
Set Netzwerk = CreateObject("wscript.network")
UserName = Netzwerk.UserName
Set wksUser = wbUser.Sheets("Userübersicht")
With wksUser
'Einlog-Daten des Users eintragen
AnzahlUser = .Cells(.Rows.Count, 1).End(xlUp).Row - 2
wksUser.Cells(AnzahlUser + 3, 1) = UserName
wksUser.Cells(AnzahlUser + 3, 2).Value = Date
wksUser.Cells(AnzahlUser + 3, 3).Value = Time
If ThisWorkbook.ReadOnly = True Then
wksUser.Cells(AnzahlUser + 3, 4).Value = "ReadOnly"
Else
wksUser.Cells(AnzahlUser + 3, 4).Value = "ReadWrite"
End If
wksUser.Cells(1, 2) = AnzahlUser + 1
End With
'Datei mit Userinfos speichern und schliessen
wbUser.Save
wbUser.Close
'Dateiattribut auf ausgeblendet und schreibgeschützt setzen
VBA.FileSystem.SetAttr sFilename, vbHidden + vbReadOnly
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Schreibschutz / Speicherschutz
16.03.2010 16:44:35
Pasi
So, ich werde mal testen ob ich es so einbauen kann. Danke schon für die Hilfe. Ich werde berichten ;-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige