I have this backup function and I want to include code to
ensure that the backup only occurs once for the end of
the month. If someone tries to do it again they get a
message saying that it has already been backed up today?

Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this workbook
backup..."

ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm_dd") & ".bak"



'.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If

I did this:

If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak")

but it ignores it.

Private Sub Backup_Button_Click()
Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave


If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak") < "" Then

MsgBox "File Already Exists!", vbExclamation,
ThisWorkbook.Name


Else

With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this workbook
backup..."



ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm") & ".bak"



'.SaveCopyAs BackupFileName
OK = True

End With
End If
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If
End Sub


Change the filename to only reflect the month and year

(Date, "_yyyy_mm_dd")

to

(Date, "_yyyy_mm")

Then you can check if the filename already exists using
the Dir command

if Dir( path & file name_yyyy_mm.bak) < "" then
' file exists
Else
make the backup
End if

you would actually build the proposed filename with path
to do the check.

--
Regards,
Tom Ogilvy

"Rhonda" wrote in message
...
I have this backup function and I want to include code
to
ensure that the backup only occurs once for the end of
the month. If someone tries to do it again they get a
message saying that it has already been backed up
today?

Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit
Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this
workbook
backup..."

ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm_dd") & ".bak"



'.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If


.

You don't need both Path and Fullname, Fullname includes the path
You need to build a date string, not just append the literal string
"_yyyy_mm".
You also need to remove the existing extension and put it on the end.

If Dir( Left(ThisWorkbook.FullName,len(thisWorkbook.Fullna me)-4) &
format(Date,"_yyyy_mm") & ".bak") < "" then
' file exists
Else
' file doesn't exist
End if

as an illustration from the immediate window:

? thisworkbook.FullName
C:\Data\aaa_scroll_area.xls

? Left(ThisWorkbook.FullName,len(thisWorkbook.Fullna me)-4) &
format(Date,"_yyyy_mm") & ".bak"
C:\Data\aaa_scroll_area_2003_09.bak


--
Regards,
Tom Ogilvy



"Rhonda" wrote in message
...
I did this:

If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak")

but it ignores it.

Private Sub Backup_Button_Click()
Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave


If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak") < "" Then

MsgBox "File Already Exists!", vbExclamation,
ThisWorkbook.Name


Else

With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this workbook
backup..."



ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm") & ".bak"



'.SaveCopyAs BackupFileName
OK = True

End With
End If
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If
End Sub


Change the filename to only reflect the month and year

(Date, "_yyyy_mm_dd")

to

(Date, "_yyyy_mm")

Then you can check if the filename already exists using
the Dir command

if Dir( path & file name_yyyy_mm.bak) < "" then
' file exists
Else
make the backup
End if

you would actually build the proposed filename with path
to do the check.

--
Regards,
Tom Ogilvy

"Rhonda" wrote in message
...
I have this backup function and I want to include code
to
ensure that the backup only occurs once for the end of
the month. If someone tries to do it again they get a
message saying that it has already been backed up
today?

Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit
Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this
workbook
backup..."

ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm_dd") & ".bak"



'.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If


.

Thanks again Tom. Before I got your message I ran what I
had through the debugger and when the cursor was above
the path I realized they both had the same info. I had
recoded it except for the format date part. There's alot
to know about this language!!


-----Original Message-----
You don't need both Path and Fullname, Fullname includes
the path
You need to build a date string, not just append the
literal string
"_yyyy_mm".
You also need to remove the existing extension and put
it on the end.

If Dir( Left(ThisWorkbook.FullName,len
(thisWorkbook.Fullname)-4) &
format(Date,"_yyyy_mm") & ".bak") < "" then
' file exists
Else
' file doesn't exist
End if

as an illustration from the immediate window:

? thisworkbook.FullName
C:\Data\aaa_scroll_area.xls

? Left(ThisWorkbook.FullName,len(thisWorkbook.Fullna me)-
4) &
format(Date,"_yyyy_mm") & ".bak"
C:\Data\aaa_scroll_area_2003_09.bak


--
Regards,
Tom Ogilvy



"Rhonda" wrote in message
...
I did this:

If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak")

but it ignores it.

Private Sub Backup_Button_Click()
Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit
Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave


If Dir(ThisWorkbook.Path & ThisWorkbook.FullName
& "_yyyy_mm.bak") < "" Then

MsgBox "File Already Exists!", vbExclamation,
ThisWorkbook.Name


Else

With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this
workbook
backup..."



ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm") & ".bak"



'.SaveCopyAs BackupFileName
OK = True

End With
End If
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!", vbInformation,
ThisWorkbook.Name

End If
End Sub


Change the filename to only reflect the month and year

(Date, "_yyyy_mm_dd")

to

(Date, "_yyyy_mm")

Then you can check if the filename already exists
using
the Dir command

if Dir( path & file name_yyyy_mm.bak) < "" then
' file exists
Else
make the backup
End if

you would actually build the proposed filename with
path
to do the check.

--
Regards,
Tom Ogilvy

"Rhonda" wrote in message
...
I have this backup function and I want to include
code
to
ensure that the backup only occurs once for the end
of
the month. If someone tries to do it again they get
a
message saying that it has already been backed up
today?

Dim awb As Workbook, BackupFileName As String, i As
Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then
Exit
Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i 0 Then BackupFileName = Left
(BackupFileName, i - 1)
'BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this
workbook..."
.Save
Application.StatusBar = "Saving this
workbook
backup..."

ThisWorkbook.SaveCopyAs Left
(ThisWorkbook.FullName, Len( _
ThisWorkbook.FullName) - 4) & Format
(Date, "_yyyy_mm_dd") & ".bak"



'.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!",
vbExclamation,
ThisWorkbook.Name

Else
MsgBox "Backup was successful!",
vbInformation,
ThisWorkbook.Name

End If


.



.