save excel file as copy to current folder VBA issue

[craig schultz]

Hi, I wonder if anyone could help me please.

I have a code below which saves the excel file as a copy to its current location and renames the file 'customer copy'

This works fine the first time, but when a file with the same name exists in the current location and I chose the option 'No' or 'Cancel' I get a run-time error.

I'm sure its a simple fix but I am fairly new to VBA and would really appreciate any help.

Sub Customercopy()
ActiveSheet.Unprotect
' Copy activesheet to the new workbook
ActiveSheet.Copy
Columns("H:J").Select
Selection.Delete Shift:=xlToLeft
Cells.Validation.Delete

Dim btn As Shape
For Each btn In ActiveSheet.Shapes
If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
Next

'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Bom has been saved with 'Denco Reference Only' Columns and All Previous Revisions Removed. Saved in Current Bom File " & ActiveWorkbook.FullName & vbLf & "Press OK to close it"

' Close the saved copy
ActiveWorkbook.Close False

ActiveSheet.Protect
End Sub

Many thanks

Craig

 

[keithmct]

am assuming the question that you are answering "No" to is something like "filename already exists. do you want to replace the current file" ???

 

[dmt32]

Hi,
see if this update to your code does what you want

Sub Customercopy()
    Dim FullFileName As String
    Dim btn As Shape
    
'copy name & filepath
    FullFileName = ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy.xlsm"
    
    If Dir(FullFileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
        
' Copy activesheet to the new workbook
        With ActiveSheet
            .Unprotect
            .Copy
        End With
        
        Columns("H:J").Delete Shift:=xlToLeft
        Cells.Validation.Delete
        
    
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        
'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
        
        With ActiveWorkbook
            .SaveAs FullFileName, xlOpenXMLWorkbookMacroEnabled
            .Close False
        End With
        
        Application.ScreenUpdating = True
'inform user
        MsgBox "Bom has been saved with 'Denco Reference Only'" & Chr(10) & _
        "Columns and All Previous Revisions Removed." & Chr(10) & Chr(10) & _
        "Saved in Current Bom File " & FullFileName & vbLf & "Press OK to close it", 64, "File Saved"
        
        ActiveSheet.Protect
    Else
'file exists
        MsgBox FullFileName & Chr(10) & "File Exists!", 16, "File Exists"
        
    End If
End Sub

I have kept the FileFormat as marco enabled workbook (xlsm) as I assume that is what you want - If though workbook contains no macros you could save it as xlsx non macro workbook.

Hope helpful

Dave

 

[craig schultz]

Yes Keith, that's correct. It gives me an error when I say 'No or 'Cancel' but works if I say yes.

Thanks

Craig

 

[craig schultz]

Thanks, yes I would like it kept as xlsm.

I would still like for the file to be overwritten if they choose to which currently works. But when the message "filename already exists. do you want to replace the current file" the "No" & "cancel" buttons create an error?

Many thanks

Craig

 

[dmt32]

Thanks, yes I would like it kept as xlsm.

I would still like for the file to be overwritten if they choose to which currently works. But when the message "filename already exists. do you want to replace the current file" the "No" & "cancel" buttons create an error?

Many thanks

Craig

Try following:

Sub Customercopy()
    Dim FullFileName As String
    Dim Response As VbMsgBoxResult
    Dim btn As Shape
    
'copy name & filepath
    FullFileName = ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy.xlsm"
    
    If Not Dir(FullFileName, vbDirectory) = vbNullString Then
    
'file exists
        Response = MsgBox(FullFileName & Chr(10) & "File Exists!" & Chr(10) & "Do You Want To Overwrite The File?", 36, "File Exists")
        If Response = vbNo Then Exit Sub
    End If
        
        With Application
            .ScreenUpdating = False: .DisplayAlerts = False
        End With
        
' Copy activesheet to the new workbook
        With ActiveSheet
            .Unprotect
            .Copy
        End With
        
        Columns("H:J").Delete Shift:=xlToLeft
        Cells.Validation.Delete
        
    
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        
'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
        
        With ActiveWorkbook
            .SaveAs FullFileName, xlOpenXMLWorkbookMacroEnabled
            .Close False
        End With
        
        Application.ScreenUpdating = True
'inform user
        MsgBox "Bom has been saved with 'Denco Reference Only'" & Chr(10) & _
        "Columns and All Previous Revisions Removed." & Chr(10) & Chr(10) & _
        "Saved in Current Bom File " & FullFileName & vbLf & "Press OK to close it", 64, "File Saved"
        
        ActiveSheet.Protect
        
        Application.DisplayAlerts = True
End Sub

I have only included the Yes No Buttons - Yes overwrites the File No exits the code.


Dave

 

[craig schultz]

Thanks Dave, that works a treat! Just what I was after

Really appreciate your help.

Thanks

Craig

 

[dmt32]

Thanks Dave, that works a treat! Just what I was after

Really appreciate your help.

Thanks

Craig

welcome - thanks for feedback


Dave