VB-Excel SaveAs method, if file exists, rename without prompting

[Kraig K]

When using the SaveAs method in VB to save my Excel sheet, if the user entered an existing filename, I want my code to just append a 1 to the end of the filename, save it and move on, no prompting, etc.

Right now if the file exists, a msgbox pops up asking if i want to over-right, if you say no, it asks to save book1. I then want that saved as Filename-1 I want this to happen all behind the scenes.

I know I could probably do some FSO stuff to check but wondering if there is a shorter way, like does the SaveAs throw an error that I can trap?

[Bruce Fox]

Personaly, I would use the FileExists API, then you will know ahead of time and prepare to save acordingly.


Also, once you have appened 1 to the FileName; that file too may exists. Therefore, you can iterate with a counter past the similar named files (using the API) until there is no match and append the counter (as the next sequential number).




Bruce.

[RobDog888]

This will work for files with a number from 1 to 9.

If ActiveWorkbook.Saved = True Then
        Dim sName As String
        Dim i As Integer
        Dim bNum As Boolean
        sName = ActiveWorkbook.Name
        'look for the version number
        i = 1
        Do While bNum = False
            If IsNumeric(Mid$(ActiveWorkbook.Name, i, 1)) = True Then
                bNum = True
                Exit Do
            End If
            i = i + 1
        Loop
        If bNum = True Then
            'Save and increment the number by 1
            ActiveWorkbook.SaveAs Replace(ActiveWorkbook.Name, Mid$(ActiveWorkbook.Name, i, 1), Mid$(ActiveWorkbook.Name, i, 1) + 1)
        Else
            'Add a 1 to the end of the name
            ActiveWorkbook.SaveAs Replace(ActiveWorkbook.FullName, ".xls", "1.xls")
        End If
    Else 'New book so save with name and 1.xls
        ActiveWorkbook.SaveAs "C:\SomeFileName1.xls"
    End If

[Kraig K]

RobDog

Seems like the ActiveWorkbook.Saved property is always false for me. Here's what happens, the users starts a new data collection run, enters some information, then the filename is auto generated based on that info. Then the CommonDialog comes up asking where to save the file, my app defaults to the C:\Data folder, so this dialog allows users to change directories. The generated filename is in the SaveAs box already. Then the app acquires data, then attempts to save. At this point a new Excel workbook is created. Here's a summary of my creation of the Excel object.

'at top of code
Dim objExcel As New Excel.Application
Dim objBook As New Excel.Workbook
'then the savedata sub
With objExcel
      Set objBook = .Workbooks.Add
'write some stuff
End With
'save the file
objBook.SaveAs FileName
'destroy objects
objExcel.Workbooks.Close
   objExcel.Quit
   Set objExcel = Nothing

So what I tried with your code is I put it where my SaveAs is and commented that out.

[Hack]

If you always want a completely unique filename, append the datetime to it. I do this with log files that get generated from my programs. My customers can run the program 20 times in a row and 20 unique files will be created. Something like

FileName = FileName & "_" & Format(Now, "mmddyyyyhhmmss") & ".xls"

[RobCrombie]

If you append yyyymmddhhmmss instead of mmddyyyyhhmmss, then the user will be able to see (in Explorer), the list of files in chronological order.

[Kraig K]

That's an idea I didn't think of.

Thanks Hack and Rob.

If anyone has any other ideas, I'm listening...

[Kraig K]

Actually, just spoke to my coworker that I developed this for, appending all that to each filename may be a little much. I guess the chances of the same file are somewhat slim, the user SHOULD be changing the info that generates it but I wanted a failsafe in case they forget so they don't lose data.

So I guess I'm back to my original thought. Looks like if I say NO to over-right the existing file, I get a 1004 error. Hmmm, this may be a way to do the check...

[Hack]

Actually, just spoke to my coworker that I developed this for, appending all that to each filename may be a little much. I guess the chances of the same file are somewhat slim, the user SHOULD be changing the info that generates it but I wanted a failsafe in case they forget so they don't lose data.

Well, if the changes are slim, you could drop the time, and just append the date. FileName_05042005.xls shouldn't be that difficult to deal with.

[Kraig K]

I think I'd like to just append the 1 to it. Not that your suggestion isn't bad. Actually, just adding the date returns me to the original problem, how to determine if the file already exists. Some things I've discovered:

The ActiveWorkbook.Name doesn't get set to my desired filename until AFTER the SaveAs method.
SaveAs does throw error 1004 but before it does it asks if I want to over-right, turning DisplayAlerts off makes it select the default choise, which is yes.

Looking at the SaveAs help, it has a conflict resolution option, but the way it reads, it won't do what I want.

Sooo close.

[Kraig K]

Did some more searching and found some nice, simple code that does exactly what I want.

Dim fName As String
fName = "c:\test.xls"
If Len(Dir(fName, vbNormal)) = 0 Then
    'Add code to create file
Else
    'The file already exists, perform some operation
End If

Now I just need to make this robust to check the appended number and I'm good! Some of Robdog's code may help there.

Thanks all.

[RobDog888]

What was wrong with "If ActiveWorkbook.Saved = True Then"?
If the document has been saved then it exists.
If its not saved then its new and doesnt exist.

[Kraig K]

What was wrong with "If ActiveWorkbook.Saved = True Then"?
If the document has been saved then it exists.
If its not saved then its new and doesnt exist.

I believe that the Saved property gets "reset" upon starting a new run in my app. Once the file is closed and the object is destroyed, the active workbook then became "Book1". In other words, once the file is closed, there is no more active workbook. Am I making sense?

[RobDog888]

Thats correct, but I guess I thought that there would be a saved version open in Excel at some point that would be used to test
against an existing file or instance.

[Kraig K]

Thats correct, but I guess I thought that there would be a saved version open in Excel at some point that would be used to test against an existing file or instance.

I suppose it could if I didn't close the file after saving, but I like to.

Anyway, here's what I came up with to append a sequential number to the end and if that new filename also exists, go to the next number, etc.

Dim k As Integer
Dim fName As String
      'check if file already exists
      If Len(Dir(FileName, vbNormal)) = 0 Then 'file does not exist
         objBook.SaveAs FileName
      Else
         fName = FileName
         Do Until Len(Dir(FileName, vbNormal)) = 0
            k = k + 1
            FileName = Replace$(fName, ".xls", "-" & k & ".xls")
         Loop
         objBook.SaveAs FileName
      End If

[RobCrombie]

It would be nice, if the list of files (viewed in explorer) were chronological.
That can be achieved by padding in front with 0's
But that then raises the 'over adaption' of limiting you to say 001 to 999

I knocked this up.
It is a black box that allows you to pass any file name, and let it increment it for you.
You can optionally tell it what separator( _ ) to use, and what length you wish the incrementor to be ( 001 or 0001 or more)

Private Sub Form_Click()
 Dim sFullFileName As String
 Dim myStr As String
 Dim cntr As Long
  sFullFileName = "MyPicture.jpeg"
  'sFullFileName = "MyPic.jpg"
  myStr = sFullFileName
  myStr = FileNameIncrement(myStr, "_") 'You could chg optional length from 3 to 4,  by passing 4
  Print myStr
  For cntr = 0 To 11
    myStr = FileNameIncrement(myStr, "_")
    Print myStr
  Next cntr
End Sub
 
'This pads the suffix(Incr), so that viewing of file names will be chronological.
'This will append say "_001"
'If you pass one with say "_003", then you'll get "_004" back
Public Function FileNameIncrement(sIN As String, Optional sSep As String = "_", Optional lenIncr As Long = 3) As String
'Author: Rob Crombie
 Dim sFn As String            ' MyPic
 Dim sFnIncr As String        ' 001  or 0001  or  00001
 Dim sFnIncrMaybe As String
 Dim lFnIncr As Long
 Dim sFnExt As String         ' .jpg  or .jpeg
 Dim sArr() As String
 Dim sWork As String          ' Working pad
 Dim sWork2 As String         ' Working pad
 'Dim lLen As Long            ' Usually  3  may be  4  (mutter, mutter)
 Dim bVirgin As Boolean       ' Lacks any previous incrementing
 Dim sMsg As String
 Dim sTitle As String
  
  If InStr(sIN, ".") = 0 Then
    sMsg = ""
    sMsg = sMsg & "       Please  give  full  file  name,  including  the  extension" & vbCrLf
    sMsg = sMsg & "                 An  example  would  be     MyPic.jpg"
    sTitle = " YOU  MUST  ALSO  INCLUDE  THE  FILE  EXTENSION"
    MsgBox sMsg, , sTitle
    Exit Function '<== Exit Function
  End If
  
  sArr = Split(sIN, ".")
  sWork = sArr(0)            ' sWork contains everything to the left of the .
  sFnExt = sArr(1)           ' Contains say  jpg
 
  'Perhaps it hasn't been here before ?
  If InStr(1, sWork, sSep) = 0 Then
    'Definitely has never been appended
    bVirgin = True
  Else
    'It contains sSep, but may just be part of file name ?
    ' sWork contains everything to the left of the .
    sArr = Split(sWork, sSep)
    sFnIncrMaybe = sArr(UBound(sArr))
    If Len(sFnIncrMaybe) <> lenIncr Then
      bVirgin = True
    Else
      'The sSep was in the correct place, but it may not be our sSep ?
      ' I'll assume that   sSep & nnn   is ours
      If IsNumeric(sFnIncrMaybe) = True Then
        'Lets convert it, and increment it, whilst we know what we are doing.
        lFnIncr = CLng(sFnIncrMaybe) + 1
      Else
        bVirgin = True
      End If
    End If
  End If
 
  If bVirgin Then
    'If it is a virgin, our job is easy. Just append say  _001
    FileNameIncrement = sWork & sSep & PadLeft("1", lenIncr, "0") & "." & sFnExt
    Exit Function '<== Exit Function
  Else
    'It had a suffix like 006,  so make that 007 instead
    'sWork = MyPic_001    we want  sFn = MyPic
    sFn = Left(sWork, Len(sWork) - (lenIncr + 1))
    'Convert the just incremented number to a string and pad it in front with 0
    sWork2 = CStr(lFnIncr)  '<== This may contain say 6, if it was _006
    '   Typically     MyPic    _             say 6        3    Pad chr
    FileNameIncrement = sFn & sSep & PadLeft(sWork2, lenIncr, "0") & "." & sFnExt
  End If
 
End Function
 
Public Function PadLeft(sIN As String, lngLen As Long, Optional sChar As String = " ") As String
'Author: Rob Crombie
 Dim sPad As String
 Dim i As Long
  If Len(sIN) > lngLen Then
    MsgBox "Passed string was too long. already", , "ERROR IN CODE THAT CALLED  PadLeft"
    Exit Function    '<===== Exit Function
  End If
  'If "" was passed, then assume they meant " "
  If Len(sChar) = 0 Then
    sChar = " "
  End If
  For i = 1 To (lngLen - Len(sIN))
    sPad = sPad & sChar
  Next i
  PadLeft = sPad & sIN
End Function

[Kraig K]

Cool Rob. A little more than what I need for the current project, but definitely looks useful! Maybe a batch file renamer??

I did change my code to append -01 so I can get up to 100 files in order, plenty for my current needs.

[RobCrombie]

A little more than what I need for the current project

Ah, such is life