Das Archiv des Excel-Forums
Nochmal: Datei speichern - Hilfe!!!!
Betrifft: Nochmal: Datei speichern - Hilfe!!!!
von: Madman
Geschrieben am: 13.10.2003 13:16:26
Moin Leute!
Hab bisher keine Vernünftige Lösung für mein Problem!
Hier nochmal die Frage:
Mit folgender Funktion will ich verhindern, daß die Datei unter "Dateiname" gespeichert wird! Leider kommt bei der Eingabe eben dieses Namens lediglich das zur Speicherung gehörende Fenster "Datei existiert bereits! Soll sie überschrieben werden?usw..." Mit Schreibschutz kann ich nicht arbeiten, da SetAttrib laut Excel- Hilfe nur bei geschlossenen Dateien funktioniert, ich jedoch diesen wahlweise ein - oder ausschalten können müßte, deshalb der Code:
On Error Resume Next
Select Case MsgBox("Sie haben nicht die Berechtigung, die Datei unter dem Originalnamen zu speichern! Wollen sie sie unter einem anderen Namen sichern?", vbYesNo)
Case vbYes
Do
fname = Application.GetSaveAsFilename("DateinameKopie.xls", "Microsoft Excel-Arbeitsmappe (*.xls), *xls")
Loop Until fname <> False And fname <> "Dateiname.xls"
ActiveWorkbook.SaveAs fname
End Select
Kann mir jemand helfen? Ist die Loop- Anweisung oder das Format des Dateinamens evtl. falsch? Bin echt verzweifelt!!!
MfG Madman
Betrifft: AW: Nochmal: Datei speichern - Hilfe!!!!
von: T1000
Geschrieben am: 13.10.2003 13:40:45
Application.GetSaveAsFilename("DateinameKopie.xls", "Microsoft Excel-Arbeitsmappe (*.xls), *xls")
einfach diese anweisung reicht doch schon zum speichern einer Datei du musst nur den "DateinameKopie.xls" ändern wenn du anderen Dateinamen haben willst
Betrifft: Ich will ja verhindern daß die Datei "Dateiname.xl
von: Madman
Geschrieben am: 13.10.2003 13:47:11
Hallo T1000
Ich will ja verhindern daß jemand die Datei unter dem Namen "Dateiname.xls" abspeichert!!! Ich mach vorher ne Paßwortabfrage, und nur ein bestimmter User (Ich) soll den Originalnamen benutzen dürfen!Wenn ich über Getsaveasfilename aber diesen eingebe, ist ein Speichern trotzdem möglich, was ich eigentlich durch die Loop- Anweisung verhindern wollte...!!!
Gruß Madman
Betrifft: AW: Ich will ja verhindern daß die Datei "Dateinam
von: T1000
Geschrieben am: 13.10.2003 14:10:55
du meinst also das wenn der "fremde" benutzer über "datei>>speichern unter" versucht zu speichern das dann pw abfrage kommt falls er unter deinem dateinamen speichern will, hmm tjo so mächtig ist vba net das der in excel so eingreifen kann, und zumal auch wenn du ne passwort abfrage machst, vba is ne Interpretersprache, des heisst dein quelltext is schön für jeden beliebigen benutzer sichtbar
Betrifft: AW: Nochmal: Datei speichern - Hilfe!!!!
von: GraFri
Geschrieben am: 13.10.2003 13:48:53
Hallo
Ändere die Zeile wie folgt:
Loop Until fname <> False And InStr(fname, "Dateiname.xls") = 0
mfg, GraFri
Betrifft: Klappt leider auch nicht...
von: Madman
Geschrieben am: 13.10.2003 14:03:48
Klappt leider auch nicht!
Es erscheint wieder der übliche Speicherdialog!
Trotzdem Danke!
Betrifft: AW: Nochmal: Datei speichern - Hilfe!!!!
von: ChrisL
Geschrieben am: 13.10.2003 13:56:44
Hi Madman
Problem ist, dass fname den gesamten Pfad enthält, du aber nur den Dateinamen überprüfst. In XL2000 wäre es mit InstrRev lösbar, aber ich habe dir nachstehend eine Versionen-unabhängige Variante.
Anstatt die berechtigten User mit einem Passwort abzufragen, schlage ich dir vor mit Environ direkt den Windows Benutzername abzufragen:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fName As Variant, ffName As String, MsgBoxAntwort As Variant
Dim Vorschlag As String
If Environ("Username") <> "DEIN-WINDOWS-BENUTZERNAME" Then
On Error GoTo ErrorHandler
Cancel = True
Vorschlag = "DateinameKopie.xls"
Start:
fName = Application.GetSaveAsFilename(Vorschlag, "Microsoft Excel-Arbeitsmappe (*.xls), *xls")
If fName = False Then Exit Sub
ffName = fName
Do Until InStr(ffName, "\") = 0
ffName = Right(ffName, Len(ffName) - InStr(ffName, "\"))
Loop
If ffName = "Dateiname.xls" Then
MsgBoxAntwort = MsgBox("Sie haben nicht die Berechtigung, die Datei unter dem Originalnamen zu speichern! Wollen sie sie unter einem anderen Namen sichern?", vbYesNo)
If MsgBoxAntwort = vbNo Then
Exit Sub
Else
GoTo Start
End If
End If
If Dir(fName) <> "" Then
MsgBoxAntwort = MsgBox("Datei existiert bereits. Wollen Sie die bestehende Datei überschreiben?", vbQuestion + vbYesNo)
If MsgBoxAntwort = vbNo Then GoTo Start
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
ActiveWorkbook.SaveAs fName
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub
ErrorHandler:
MsgBox "Fehler: Datei konnte nicht gespeichert werden.", vbCritical
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub
Gruss
Chris
Betrifft: Klappt super,DANKE!!!
von: Madman
Geschrieben am: 13.10.2003 14:22:04
Hab den Code so ähnlich verwendet, klappt super! Die Idee mit dem Benutzernamen ist gut, es sollen jedoch mehrere Personen Zugriff haben, deshalb doch Paßwortschutz!
MfG Madman
Betrifft: Danke für die Rückmeldung oT
von: ChrisL
Geschrieben am: 13.10.2003 14:47:37
Betrifft: AW: Nochmal: Datei speichern - Hilfe!!!!
von: Michael Schefler
Geschrieben am: 13.10.2003 13:58:02
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "This must not saved!", vbOKOnly, "Repair 2000"
Cancel = True
End Sub
Excel-Beispiele zum Thema " Nochmal: Datei speichern - Hilfe!!!!"