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

--
Message posted from http://www.ExcelForum.com

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

Thanks

Simo

--
Message posted from http://www.ExcelForum.com

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


---
Regards,
Norman



"Simon Lloyd " wrote in message
...
Hi all,
I have this code fo creating a monthly back up which works fine, but
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 Sub


---
Message posted from http://www.ExcelForum.com/

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

--
Message posted from http://www.ExcelForum.com

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

--
Message posted from http://www.ExcelForum.com

Hi Simon,

I tested the code in xl2k without your observed problem.

Perhaps you could paste the following simple macro into the offending
workbook and post the returned message.

Sub Test()
MsgBox ActiveWorkbook.Name & vbNewLine _
& GetAttr(ActiveWorkbook.Name)
End Sub


Of no relevance to the immediate problem, I would change the line

If GetAttr(.Name) = 1 Then Exit Sub

to:

If GetAttr(Name) Mod 2 = 1 Then Exit Sub

This is to catch combined attributes.


---
Regards,
Norman



"Simon Lloyd " wrote in message
...
Hi Norman,

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

Any further input will be greatly recieved.

simon


---
Message posted from http://www.ExcelForum.com/

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

--
Message posted from http://www.ExcelForum.com

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

--
Message posted from http://www.ExcelForum.com

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.


---
Regards,
Norman



"Simon Lloyd " wrote in message
...
Norman thanks for the response but the program now hangs on this line If
GetAttr(.Name) = 1 Then Exit Sub before it gets to the original line it
hung up on, 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.

Simon


---
Message posted from http://www.ExcelForum.com/