Datei mit Schreibschutz öffnen und speichern
18.06.2014 14:40:36
Sinayli57
habe eine Datei, die per Makro in eine zweite Datei (Datenbank) Einträge macht.
Die Datenbank-Datei habe ich neuerdings mit einem Schreibschutz versehen.
Hintergrund ist, dass wenn einer die Datenbank geöffnet hatte, wurde nicht in die Datenbank geschrieben.
Habe etwas im Netz gefunden (ReadOnly:=True, WriteResPassword:="abc", IgnoreReadOnlyRecommended:=True), wie man eine Datei mit schreibschutz zwar öffnet, doch kommt dann die Fehlermeldung:
Die Datei existiert bereits an dem Speicherort. Soll sie ersetzt werden?
Ich möchte, dass das Makro die Datei öffnet, die Einträge setzt und dann wieder so speichert, dass wieder der schreibschutz für die Datei gesetzt ist.
Hier der Code:
Sub Datenbankeintrag()
Dim StartZeileQ As Long, EndZeileQ As Long, AnzZeilenZ As Long, StartSpalteQ As Long, _
EndSpalteQ As Long
Dim AktSpalteQ As Long
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Workbooks.Open Filename:="V:\VI\SSC_Europa\Allgemein\Preiskalkulationstool\ _
Kalkulationsdatenbank.xlsx", ReadOnly:=True, WriteResPassword:="abc", IgnoreReadOnlyRecommended:=True
Set wsQuelle = ThisWorkbook.Worksheets("Elo")
Set wsZiel = Workbooks("Kalkulationsdatenbank.xlsx").Worksheets("Datenbank")
StartZeileQ = 100
EndZeileQ = 145
StartSpalteQ = 2
EndSpalteQ = 28
With wsZiel
AnzZeilenZ = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
End With
wsZiel.Unprotect Password:="abc"
For AktSpalteQ = StartSpalteQ To EndSpalteQ
If wsQuelle.Cells(StartZeileQ, AktSpalteQ) "" Then
'wenn ungleich "" leer erste Zeile der akt Spalte, dann kopieren, transformieren
With wsQuelle
.Range(.Cells(StartZeileQ, AktSpalteQ), .Cells(EndZeileQ, AktSpalteQ)).Copy
wsZiel.Cells(AnzZeilenZ, 2).PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:= _
False, Transpose:=True
AnzZeilenZ = AnzZeilenZ + 1
End With
End If
Next AktSpalteQ
wsZiel.Protect Password:="abc"
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
Anzeige