Don't want to over write file ?

[User457]

Hi All

was wondering if someone could look at this code....

Sub MyMacro()
Dim WS As Worksheet
Dim MyDay As String
Dim MyMonth As String
Dim MyYear As String
Dim MyPath As String
Dim MyFileName As String
Dim MyCellContent As Range
MyDay = Day(Date)
MyMonth = Month(Date)
MyYear = Year(Date)
MyPath = "C:\INVOICES"

Set WS = ActiveSheet
Set MyCellContent = WS.Range("G13")

MyFileName = "Invoice_" & MyCellContent & "_" & MyDay & "." & MyMonth & "." & MyYear & ".xls"

WS.Copy
ChDir MyPath

If CInt(Application.Version) <= 11 Then
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
    MyFileName, _
    ReadOnlyRecommended:=True, _
    CreateBackup:=False

Else
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
    MyFileName, FileFormat:=xlExcel8, _
    ReadOnlyRecommended:=True, _
    CreateBackup:=False
End If

'Invoice Details Cleared
    MsgBox "Invoice Saved.  Click New Invoice Number."
ActiveWorkbook.Close
End Sub

I'm running this from a button in excel. The problem I have is that I don't want the code to be able to overwrite the file if it already exists, I'd rather it popped up a message saying file already exists ?

The filename comes from a cell within the worksheet that updates so each filename should be unique, but if for some reason the user doesn't update then I need this message to display to stop the user accidently overriting the file ?

Hope that makes sense ?

If you need any more info please let me know.

Please note I used this code....

Application.DisplayAlerts = False

To stop the excel compatability window coming up when file is saved.

Thanks

User457

[JKwan]

give this a try

Sub MyMacro()
    Dim WS As Worksheet
    Dim MyDay As String
    Dim MyMonth As String
    Dim MyYear As String
    Dim MyPath As String
    Dim MyFileName As String
    Dim MyCellContent As Range
    MyDay = Day(Date)
    MyMonth = Month(Date)
    MyYear = Year(Date)
    MyPath = "C:\INVOICES"
    
    Set WS = ActiveSheet
    Set MyCellContent = WS.Range("G13")
    MyFileName = "Invoice_" & MyCellContent & "_" & MyDay & "." & MyMonth & "." & MyYear & ".xls"
    WS.Copy
    ChDir MyPath
    If CInt(Application.Version) <= 11 Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:= _
        MyFileName, _
        ReadOnlyRecommended:=True, _
        CreateBackup:=False
    Else
        Application.DisplayAlerts = False
        If Len(Dir(MyPath & "\" & MyFileName)) > 0 Then
            If MsgBox("File exists, do you want to over write", vbYesNo) = vbYes Then
                ActiveWorkbook.SaveAs Filename:= _
                MyFileName, FileFormat:=xlExcel8, _
                ReadOnlyRecommended:=True, _
                CreateBackup:=False
                'Invoice Details Cleared
                MsgBox "Invoice Saved. Click New Invoice Number."
            Else
                MsgBox "Invoice not Saved. Click New Invoice Number."
            End If
        Else
            ActiveWorkbook.SaveAs Filename:= _
            MyFileName, FileFormat:=xlExcel8, _
            ReadOnlyRecommended:=True, _
            CreateBackup:=False
            'Invoice Details Cleared
            MsgBox "Invoice Saved. Click New Invoice Number."
        End If
    End If
    ActiveWorkbook.Close
End Sub