PDA

View Full Version : Don't want to over write file ?



User457
12-18-2015, 09:30 AM
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
12-18-2015, 10:45 AM
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