Save File with Reference that will increment

I need to save a file that will save with a reference but if that file/ref already exists I need the reference to increment by 1

So..... i.e.

I would like the file to save as activeworkbook.saveas "P:\Country\Client\ABC00001 110214.xlsm

[110214 being the current days date]

Then the next file

I would like the file to save as activeworkbook.saveas "P:\Country\Client\ABC00002 110214.xlsm

Thanks
JagwarmanAsked:
Who is Participating?
 
MacroShadowCommented:
Ok, so this should take care of that.

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim fso As Object

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")

    If strFile <> "" Then
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
    End If
    
    If intMax < 1 Then intMax = 1
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

    Do While strFile <> ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        Set fso = Nothing
        strFile = Dir
    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub
                                            

Open in new window

0
 
Alex Green3rd Line Server SupportCommented:
You'll need to run it as a macro but here

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1008

It should all be there for you
0
 
Rgonzo1971Commented:
HI,

pls try

Sub Macro()
myDate = "110214"
Idx = 1
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
Filename = "P:\Country\Client\ABC" & Format(Idx, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs Filename
End Sub

Open in new window

Regards
0
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

 
MacroShadowCommented:
How about this:
Sub Demo()

    Dim strFilePath As String, strFile As String
    Dim strMax As String, strFilename As String
    
    strFilePath = "P:\Country\Client\"
    
    strFile = Dir(strFilePath & "*xlsm")

    Do While strFile <> ""
        strMax = Mid(strFilePath, InStr(strFilePath, " ") - 5, 5)
        strFile = Dir
    Loop
    
    If strMax = "" Then strMax = "00000"
    
    strFilename = "ABC" & Format(strMax + 1, "00000") & " " & Format(Date, "DDMMYY") & ".xlsm"
    
    ActiveWorkbook.SaveAs strFilename
    
End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
Rgonzo1971 yours is coming up with Variable not defined in mydate, Idx, ExcelFile etc

can you help
0
 
JagwarmanAuthor Commented:
MacroShadow, Your onesaved the original file ok but then when I saved another it wanted to save with the same name as the previous one so not incrementing.
0
 
Rgonzo1971Commented:
Hi

with Dims

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 1
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

Regards
0
 
MacroShadowCommented:
Sorry. Fixed version.

EDIT: Hopefully this time for real:)

Sub Demo()

    Dim strFilePath As String, strFile As String
    Dim intMax As String, strFilename As String
    
    strFilePath = "P:\Country\Client\"
    
    strFile = Dir(strFilePath & "*xlsm")

    Do While strFile <> ""
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
        strFile = Dir
    Loop
    
    If intMax = "" Then intMax = 0
    
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & Format(Date, "DDMMYY") & ".xlsm"
    
    ActiveWorkbook.SaveAs strFilename
    
End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
MacroShadow, Same as before....Your one saved the original file ok but then when I saved another it wanted to save with the same name as the previous one so not incrementing.
0
 
JagwarmanAuthor Commented:
Rgonzo1971 it saves the file but then when I save next time it says A file named ABC00001 120214.xlsm already exists............

It should save the next file as ABC00002 120214.xlsm

Thanks
Regards
0
 
MacroShadowCommented:
I read your question again (and again and again...) and I don't understand what you are trying to do.

Are you trying to loop thru a folder and rename all existing files? Or are you trying to save the current workbook once for each existing file, or is it something else all together?
0
 
Rgonzo1971Commented:
Hi,

I forgot to add one

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

Regards
0
 
JagwarmanAuthor Commented:
MacroShadow

appreciate the help. In answer to your question......

Lets call the file with the Macro in 'Master copy' and all sheets are blank.

We enter data into sheets on the 'Master copy' and when we save that file it saves as ABC00001 110214.xlsm.  So the 'Master copy' is as it was originally, all sheets are blank.
When we open 'Master copy' all sheets are blank and we enter data into sheets on the 'Master copy' and then when we save that file it saves as ABC00002 110214.xlsm.

Hope this helps.
0
 
MacroShadowCommented:
Got it.

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim blnFileExists As Boolean

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    intMax = 0
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")

    Do While strFile <> ""
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))

        strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")

        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        
        Set fso = Nothing

        strFile = Dir

    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
Quite bizzare MacroShadow.

This time it is saving the file as client.xlsm.
0
 
JagwarmanAuthor Commented:
MacroShadow

even more bizzare, it is working now.

I will test it again tomorrow.

Regards
0
 
JagwarmanAuthor Commented:
there is some very odd stuff going on here. Now that I have put the macro in the ctual file it falls over on the line

ActiveWorkbook.saveas Filename:=strFilePath & strFilename


Method save as object workbook failed
0
 
MacroShadowCommented:
I tested the code and it worked fine.

Is the actual file a macro-enabled file (.xlsm)?
0
 
JagwarmanAuthor Commented:
yes the actual file is a macro enabled file.

Regards
0
 
JagwarmanAuthor Commented:
Rgonzo1971 did you have any additional thoughts?
0
 
Rgonzo1971Commented:
Do you have the same error

with my code posted on 2014-02-12 at 13:17:03

Regards
0
 
JagwarmanAuthor Commented:
When I try it on my test file it falls over at 'ActiveWorkbook.saveas Filename:=strFilePath & strFilename

Method save as object workbook failed

If I then take it back to
strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm" and continue to run it from there it works.


When I try in in my actual file [macro enabled] it falls over at 'intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))'  

Invalid procedure call or argument

If I then move on to
 
strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm" and continue to run it from there it works.


This is so very frustrating as it is so near.
0
 
JagwarmanAuthor Commented:
Hi Rgonzo1971

It's very odd I can't find your post  [ 2014-02-12 at 13:17:03]  but I can find Posted on 2014-02-12 at 04:17:03 and I am sure I posted a reply to that one, However, at this point 'If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then' I get the error 'Subscript out of Range'

Regards
0
 
Rgonzo1971Commented:
What is the value of ExcelFile at this point?
0
 
JagwarmanAuthor Commented:
Sorry Rgonzo, what does that mean?
0
 
JagwarmanAuthor Commented:
what is also interesting Rgonzo1971 is that the initial save works but saves the file as ABC00002 ddmmyy.xlsm  not ABC00001 but it's the following time when I want to save that it falls over. as an FYI I have called my test file book1 and after the initial save I open book1 again and run that to save as ABC00002 etc. I am not trying to save the file that was saved as ABC00001 to save it again.

hope this info helps
0
 
Rgonzo1971Commented:
Try this code



Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    MsgBox ExcelFile
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
Rgonzo1971 that comes up with the MsgBox stating ABC00002 but 2 already exists it then falls over at Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))....Subscript out of range.

Regards
0
 
Rgonzo1971Commented:
That was intended

pls try

what are the 2 messages?

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    MsgBox "Part1: " & Split(ExcelFile, " ")(0)  
     MsgBox "Part2: " & Split(ExcelFile, " ")(1)
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir()
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

0
 
MacroShadowCommented:
Sorry to interfere ...

In my code what is the value of strFilePath & strFilename at the time of the error?

To find the answer to my question:
1. Open the immediate window (Ctrl+G)
2. In the immediate window type ?strFilePath & strFilename
3. Hit enter

What is the value you get?
0
 
JagwarmanAuthor Commented:
Part1: ABC0002
Part2: 130214.xlsm [you have xslm in macro so I changes to xlsm]

then it falls over at If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then......

Subscript out of range.
0
 
JagwarmanAuthor Commented:
Hi MacroShadow

you are defo not interfering......

?strFilePath & strFilename
Z:\Test files\JK\

But what is interesting is it is sporadic. Sometimes it works.

it is falling over now at

with method Saveas of object workbook failed
0
 
Rgonzo1971Commented:
Hi,

Now I think I've got this error fixed

pls try

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
        ExcelFile = Dir()
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub 

Open in new window

Regards
0
 
MacroShadowCommented:
Does this work?

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim fso As Object

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")
    intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
    
    If intMax < 1 Then intMax = 1
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

    Do While strFile <> ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        Set fso = Nothing
        strFile = Dir
    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
It works fine if there is already a file with ABC00001 already there otherwise it falls over at

intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))

Invalid procedure call or argument
0
 
Rgonzo1971Commented:
And how about mine?
0
 
JagwarmanAuthor Commented:
both MacroShadow and Rgonzo1971 have worked effortlessly to help me resolve this one and both of their solutions are brilliant. I can't really say which one is the better solution but the Experts system forces me to choose one over the other. so, even though my tick is is one of them, Thank you both I am giving you both 250 points. If I had my choice you would both get 500
0
 
MacroShadowCommented:
Thank you.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.