Can you fix this?? vbreadonly

[Simon Lloyd]

Hi all,
I have this code fo creating a monthly back up which works fine, bu
trying to make the back up Read Only is causing a problem!

This code gives me a problem at the line Set Attr sStr ,VB ReadOnly
does anyone know a fix for this?

Here's the code....

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lDat_Today As Date
Dim lDat_Tomorrow As Date
Dim lStr_TargetFile As String
Dim sStr As String
Dim sName As ThisWorkbook

lDat_Today = Date
If "Fri" = Format(Date, "ddd") Then
lDat_Tomorrow = Date + 3
Else
lDat_Tomorrow = Date + 1
End If

With ThisWorkbook
If Month(lDat_Today) = Month(lDat_Tomorrow) Then
Else
sStr = ThisWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, InStr(1, _
LCase(ThisWorkbook.Name), _
".xls") - 1) & _
" - " & Format(Now, "yyyymmdd") & ".xls"
End If

.SaveCopyAs sStr
SetAttr sStr, vbReadOnly
.Save

End With
End Su

 

[Simon Lloyd]

One other thing!....i need the back up copy never to make a back up o
itself even on the month change.

Thanks

Simo

 

[Norman Jones]

Hi Simon,

Try:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lDat_Today As Date
Dim lDat_Tomorrow As Date
Dim sStr As String

With ThisWorkbook
'Check ReadOnly status to establish if
'this is a backup copy
If GetAttr(.Name) = 1 Then Exit Sub
lDat_Today = Date
If Format(Date, "ddd") = "Fri" Then
lDat_Tomorrow = Date + 3
Else
lDat_Tomorrow = Date + 1
End If

If Not Month(lDat_Today) = Month(lDat_Tomorrow) Then
sStr = .Path & "\" & _
Left(.Name, InStr(1, _
LCase(.Name), _
".xls") - 1) & _
" - " & Format(Now, "yyyymmdd") & ".xls"
On Error Resume Next
SaveCopyAs sStr
On Error GoTo 0
SetAttr sStr, vbReadOnly
End If
End With
End Sub

 

[Simon Lloyd]

Norman thanks for the response but the program now hangs on this line I
GetAttr(.Name) = 1 Then Exit Sub before it gets to the original line i
hung up on, i have tried at the top of the code to write On Erro
Resume Next but this just skipped the line and did nothing with th
rest of the program.

Simo

 

[Simon Lloyd]

Hi Norman,

The code is installed in a workbook that has been previously saved an
and works fine with out the GetAttr statements or Set attr i have trie
putting it in another workbook and got the same effect im using exce
2000.

Any further input will be greatly recieved.

simo

 

[Simon Lloyd]

Hi Norman,

Well i made the mod you suggested still no joy, i was unsure where t
insert the sub you gave for the message box but when i tried runnin
the sub in any workbook it came up file not found in an excel error bo
not a msgbox.

Any thoughts?

Simo

 

[Simon Lloyd]

Hi all,

The SetAttr function works fine, but the GetAttr function causes
runtime 53 error. Do i need to use the AND operator if so how and wher
do i use it?

So in summary....the setting of the backup attribute to read only work
and the Get Attributes does not, i have tried variations of this....th
workbook im using is in excel 2000 and is a clean workbook with n
other code in (i'm using it for test purposes before making a pigs ea
out of the one it is needed for!)

Can anyone help?

Simo

 

[Norman Jones]

Hi Simon,

The only way that I could replicate your problem was to run the code in a
new unsaved workbook.

Do you really want to backup a workbook that has never been saved?

i have tried at the top of the code to write On Error
Resume Next but this just skipped the line and did nothing with the
rest of the program.

Your condition:

If Not Month(lDat_Today) = Month(lDat_Tomorrow) Then

is used to determine if today is the last day of the month and, if so,
create a date-stamped backup file. As written, if today is not the last day
of the month, the file closes without any additional action. This may or may
not be what you intend.

You should also note that your routine will only produce a backup file if
the file is opened (or, more properly, closed) on the last day of the month.