AW: gesperrte Tabelle mit Netzwerk, User - Name
11.09.2005 22:17:23
Matthias
Hallo Nick,
ein wenig schwierig bei deinem Kenntnisstand...
Mein Vorschlag:
Beim Öffnen der Datei wird eine kleine Textdatei erzeugt, die die Endung .cur hat (für Current). Diese enthält dann die Info über Benutzername und Computername.
Diese Datei müsste im "Echtbetrieb" aber immer mit eier kleinen Startdatei (z.B. Start.xls) im gleichen Verzeichnis gestartet werden. Die Datei Start.xls prüft dann, ob die Datei Test.xls in Bearbeitung ist. Wenn ja, liest die die Daten der Textdatei aus und zeigt diese in einer MsgBox an. Wenn nicht, öffnet Start.xls die Datei Test.xls und schließt sich dann selbst.
Kann natürlich verfeinert werden, it nur mal ein grober Entwurf.
Der Code in der Datei "Start.xls", in "DieseArbeitsmappe":
Option Explicit
Private Sub Workbook_Open()
Dim fn As String
Dim user As String, computer As String
fn = ThisWorkbook.Path & "\test.xls"
If GetUserInfo(fn, user, computer) Then
MsgBox fn & " wird bearbeitet von:" & vbLf & _
user & " auf: " & computer, vbExclamation
ThisWorkbook.Close False
Else
Workbooks.Open Filename:=fn
ThisWorkbook.Close False
End If
End Sub
Private Function GetUserInfo(ByVal fn As String, ByRef user As String, ByRef computer As String) As Boolean
Dim f As String
f = WorksheetFunction.Substitute(fn, ".xls", ".cur")
If DateiInBearbeitung(fn) Then
Dim ff
ff = FreeFile()
On Error Resume Next
Open f For Input As #ff
Line Input #ff, user
Line Input #ff, computer
Close #ff
GetUserInfo = True
Else
If Dir(f) <> "" Then Kill f
user = ""
computer = ""
GetUserInfo = False
End If
End Function
Private Function DateiInBearbeitung(S As String) As Boolean
If Dir(S) = "" Then
DateiInBearbeitung = False
Exit Function
End If
On Error Resume Next
Open S For Binary Access Read Lock Read As #1
Close #1
If Err.Number <> 0 Then
DateiInBearbeitung = True
Err.Clear
End If
End Function
______________________________________________________________________________
Der Code in der Datei "Test.xls", in "DieseArbeitsmappe":
Option Explicit
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly = False Then SaveUserInfos
End Sub
Private Sub SaveUserInfos()
Dim f As String
Dim ff
f = WorksheetFunction.Substitute(ThisWorkbook.FullName, ".xls", ".cur")
ff = FreeFile()
On Error Resume Next
Open f For Output As #ff
Print #ff, Environ("username")
Print #ff, Environ("computername")
Close #ff
End Sub
Bis hierhin erstmal...
Grüße,
Matthias