Hi

I am trying to create a read only open access copy of a file that is password protected. Trouble is I can't remove the password from the copy only and force read only onto the copy

This is the code I tried

Private Sub CommandButton1_Click(
Application.DisplayAlerts = Fals
Kill "S:\Common\Gx\x.XLS
ActiveWorkbook.SaveAs ("s:\unit\q.xls"), FileFormat:=xlNormal, Password:="", WriteResPassword:=" ", ReadOnlyRecommended:=True
, CreateBackup:=Fals
ActiveWorkbook.SaveCopyAs ("S:\Common\Gx\x.XLS"
Application.DisplayAlerts = Tru
ActiveWorkbook.Clos
End Su

Appreciate any help.

I'm not sure if there's a way to make a file read only in Excel, but you can do it with the FileSystemObject of the Scripting library. Try the following procedure

Sub MakeReadyOnly(strFile As String
' strFile should resemble c:\Book1.xl

Dim fso As Objec
Dim file As Objec

Set fso = CreateObject("Scripting.FileSystemObject"
Set f = fso.GetFile(strFile

f.Attributes = 1 ' 1 is read only. 32 is archive. 32 + 1 is 33 for Archive and ReadOnl

Set fso = Nothin
Set f = Nothin
End Su

-Brad Vontur

Private Sub CommandButton1_Click()
Dim sName as String
sName = "S:\Common\Gx\x.xls"
Application.DisplayAlerts = False
Kill sName
ActiveWorkbook.SaveAs ("s:\unit\q.xls"), FileFormat:=xlNormal, _
Password:="", WriteResPassword:=" ", ReadOnlyRecommended:=True _
, CreateBackup:=False
ActiveWorkbook.SaveCopyAs sName
setAttr sName, vbReadOnly
Application.DisplayAlerts = True
End Sub

--
Regards,
Tom Ogilvy



"Lawlera" wrote in message
...
Hi,

I am trying to create a read only open access copy of a file that is
password protected. Trouble is I can't remove the password from the copy
only and force read only onto the copy.

This is the code I tried:

Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
Kill "S:\Common\Gx\x.XLS"
ActiveWorkbook.SaveAs ("s:\unit\q.xls"), FileFormat:=xlNormal,
Password:="", WriteResPassword:=" ", ReadOnlyRecommended:=True _
, CreateBackup:=False
ActiveWorkbook.SaveCopyAs ("S:\Common\Gx\x.XLS")
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub

Appreciate any help.