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


.