Schreibschutz in Excel

[XHelp]

Ich habe es endlich hingekriegt:

Code:

procedure TForm1.Button2Click(Sender: TObject);
var
xls, xlw, xlw1: Variant;
p:string;
i,i1:integer;
sl:TStringList;
sr: TSearchRec;
begin
ForceDirectories(ExtractFileDir(Application.ExeName) + '\protected\' );
{load MS Excel}
xls := CreateOLEObject('Excel.Application');
sl:=TStringList.Create;
if FindFirst(ExtractFileDir(Application.ExeName) + '\*.xls', faAnyFile, sr) = 0 then
  begin
    repeat
      sl.Add(ExtractFileDir(Application.ExeName) + '\' + sr.Name);

    until FindNext(sr) <> 0;
  FindClose(sr);
end;
PB1.Max:=sl.Count-1;
PB1.Position:=0;
for i:=0 to sl.Count-1 do begin
      {open your xls-file}
      xlw := xls.WorkBooks.Open(FileName :=sl[i] , Password := '', ReadOnly := True);
      pb2.Max:=xls.Sheets.count;
      for i1:=1 to xls.Sheets.count do begin
        xlw1 := xls.Sheets[i1];
        {save with other file name}
        xlw1.Protect(Edit2.Text,true,true);
        pb2.Position:=i1;
      end;
      xlw.SaveAs(FileName := ExtractFileDir(sl[i]) + '\protected\' + ExtractFileName(sl[i]), Password := '');
      xls.Workbooks.close;
      pb1.Position:=i;
end;
xls.Application.Quit;

{unload MS Excel}
xlw := UnAssigned;
xls := UnAssigned;

ShowMessage('Complete');
end;