VBA SaveAs crashing Excel

[Kra]

Hi all!

I am trying to create code to save active workbook as file with specific name in specific folder. It works fine till Loop with creating new name if file already exists - Excel is not responding after running this macro.

What I am trying to achieve is to check if file with this name already exists in folder C:\Local\KRA. If no, then save file in this folder with name "File" and today's date in format YYYYMMDD (so it would be "File 20221026").
if file already exists, then add an version number to the name (so it would be "File 20221026 v2"). But in this case everything explodes. Any ideas how to fix it?

Private Sub CommandButton7_Click()
    
     Dim x As Long
     Dim Version As String
     Dim FName As String
     
     Saved = False
     
    FName = "C:\Local\KRA\File " & _
                 Format(Date, "YYYYMMDD") & ".xlsx"
    Version = " v"
    x = 2
          
    'If no files with same name exist
    If Dir(FName) = "" Then
            ActiveWorkbook.SaveAs Filename:=FName, _
                              FileFormat:=xlOpenXMLWorkbook
            Exit Sub
    End If
    
    'Else create new version
    Do While Saved = False
        If Dir(FName) = "" Then
            ActiveWorkbook.SaveAs Filename:=FName & Version & x, _
                              FileFormat:=xlOpenXMLWorkbook
            Saved = True
         Else
            x = x + 1
        End If
    Loop
    
    MsgBox "Saved as version " & x

    
End Sub

 

[HaHoBe]

Hi Kra,

where is the code located and started from as CommandButton7_Click leads me more to think of ThisWorkbook rather than ActiveWorkbook and either a button on a sheet or on an UserForm.

Private Sub CommandButton7_Click()
'https://www.mrexcel.com/board/threads/vba-saveas-crashing-excel.1220367/
 
  Dim lngVers As Long
  Dim strVersion As String
  Dim strFName As String
  Dim strNewVers As String
  
  Const cstrExt As String = ".xlsx"
 
  strFName = "C:\Local\KRA\File " & _
               Format(Date, "YYYYMMDD")
  strVersion = " v"
  lngVers = 2
       
  'If no files with same name exist
  If Dir(strFName & cstrExt) = "" Then
    ActiveWorkbook.SaveAs Filename:=strFName & cstrExt, _
                      FileFormat:=xlOpenXMLWorkbook
    Exit Sub
  End If
 
  strNewVers = strVersion & lngVers
  'Else create new Version
  Do Until Dir(strFName & strNewVers & cstrExt) = ""
    lngVers = lngVers + 1
    strNewVers = strVersion & lngVers
  Loop
  ActiveWorkbook.SaveAs Filename:=strFName & strNewVers & cstrExt, _
                    FileFormat:=xlOpenXMLWorkbook
 
  MsgBox "Saved as version " & lngVers

End Sub

Ciao,
Holger

 

[Kra]

Hi Kra,

where is the code located and started from as CommandButton7_Click leads me more to think of ThisWorkbook rather than ActiveWorkbook and either a button on a sheet or on an UserForm.

Private Sub CommandButton7_Click()
'https://www.mrexcel.com/board/threads/vba-saveas-crashing-excel.1220367/
 
  Dim lngVers As Long
  Dim strVersion As String
  Dim strFName As String
  Dim strNewVers As String
 
  Const cstrExt As String = ".xlsx"
 
  strFName = "C:\Local\KRA\File " & _
               Format(Date, "YYYYMMDD")
  strVersion = " v"
  lngVers = 2
      
  'If no files with same name exist
  If Dir(strFName & cstrExt) = "" Then
    ActiveWorkbook.SaveAs Filename:=strFName & cstrExt, _
                      FileFormat:=xlOpenXMLWorkbook
    Exit Sub
  End If
 
  strNewVers = strVersion & lngVers
  'Else create new Version
  Do Until Dir(strFName & strNewVers & cstrExt) = ""
    lngVers = lngVers + 1
    strNewVers = strVersion & lngVers
  Loop
  ActiveWorkbook.SaveAs Filename:=strFName & strNewVers & cstrExt, _
                    FileFormat:=xlOpenXMLWorkbook
 
  MsgBox "Saved as version " & lngVers

End Sub

Ciao,
Holger

Hi Holger,

Macro is in Personal.xlsb in user form. Your version works perfectly, thank you!

 

[HaHoBe]

Hi Kra,

thanks for the feedback.

I asked as I had started on a workbook with code (*.xlsm) where further codelines would be needed.

Ciao.
Holger