Problem executing macro on first run after opening workbook

zott69

New Member
Joined
Jul 9, 2015
Messages
1
Hi

This is my first post, and I'm quite a newbie to VB so please be gentle.

I'm having an issue whereby the code that I've written (with a little help) to save the existing file as new, which checks to see if a file already exists with the same name, doesn't run as expected on first run after opening the workbook.

In the code, I try to bypass the automatic prompt for "file already exists" to give the user the option to change the filename and so the macro doesn't break. But on first run, the automatic prompt comes up, meaning when you choose No/Cancel the error code '1004' comes up and breaks the macro.

Strangley, the macro works fine the second time you run it.

Code:
Sub save_it_as_new()

    dToday = Format(DateTime.Now, "yyyymmdd")
    x = MsgBox("This will save as a new file with today's date", vbOKCancel, "")
    f = "name_of_file " & dToday & ".xlsm"

[COLOR=#ff0000]'''on first run the code follows Case 1, on second run the code follows (correctly) Case Else[/COLOR]
    Select Case x
    Case 1
        If Not FileExist((f)) Then [COLOR=#008000]'file doesn't exist[/COLOR]
        
        ChDrive "C:\"
        ChDir "C:\location\of\file\"


        ActiveWorkbook.SaveAs f
        
        Else [COLOR=#008000]'file does exist[/COLOR]
            z = MsgBox("Filename already exists - overwrite?", vbYesNoCancel, "")


            Select Case z
            Case 6 [COLOR=#008000]'user pressed Yes[/COLOR]
                Application.DisplayAlerts = False
                 ChDrive "C:\"
                 ChDir "C:\location\of\file\"


                 ActiveWorkbook.SaveAs f
                 Application.DisplayAlerts = True
            Case 7 'user pressed No
                 Application.GetSaveAsFilename
                
            Case 2 [COLOR=#008000]'user pressed Cancel[/COLOR]
                 Exit Sub
               End Select
         End If
        
    Case 2 [COLOR=#008000]'user pressed Cancel[/COLOR]
        Exit Sub
        
    End Select
     
End Sub


Function FileExist(FilePath As String) As Boolean
[COLOR=#008000]'PURPOSE: Test to see if a file exists or not[/COLOR]
[COLOR=#008000]'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault[/COLOR]
[COLOR=#008000]'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm[/COLOR]


Dim TestStr As String


  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0


[COLOR=#008000]'Determine if File exists[/COLOR]
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If


End Function
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Forum statistics

Threads
1,214,652
Messages
6,120,747
Members
448,989
Latest member
mariah3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top