Solved: Saving files increment of 1

[inajica]

I need a code that will save files increment of 1. My macro opens a workbook, then adds another workbooks, and I need the addworkbook to be saved. There are 100 files that I need to be opened and saved. It would look something like this:
Player001.xslx
Player002.xlsx
Player003.xlsx

Thank you for any help

[MaximS]

try this:


Dim yourDir As String
yourDir = "C:\YourFolder\"

ChDir yourDir

For i = 1 To 100

j = Right("00" & i, 3)

Workbooks.Open Filename:=yourDir & "\Player" & j & ".xlsx"

ActiveWorkbook.SaveAs Filename:=yourDir & "\Player" & j & ".xlsx" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Next i

[Kenneth Hobs]

This code creates new workbooks but does not check to see if one exists with the same name before saving.

Sub Make100Files()
Dim wbName As String, x As Integer
Dim bName As String, bPath As String
bName = "Player"
bPath = ThisWorkbook.Path & "\" & bName
If Dir(bPath, vbDirectory) = "" Then MkDir bPath

For x = 1 To 100
Application.Workbooks.Add
wbName = bPath & "\" & bName & Format(x, "000") & ".xls"

'Replace next line with your data entries
[A1] = wbName

'Save and close each
ActiveWorkbook.SaveAs Filename:= _
wbName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close False
Next x
End Sub

[CreganTur]

tstav (http://vbaexpress.com/kb/getarticle.php?kb_id=1008&PHPSESSID=fd050609029f66c6e762b8f72bbb4d79) already created this for the kb. Take a look at the entry (click his name).

[inajica]

Thanks for the reply. Can I get a code that if the filename exists with the same name, it will save it with the next increment number.

[MaximS]

Try this:


Dim yourDir As String
yourDir = "C:\YourFolder\"

ChDir yourDir

For i = 1 To 100

j = Right("00" & i, 3)

If File_Exists(yourDir & "\Player" & j & ".xlsx") = True Then

Workbooks.Open Filename:=yourDir & "\Player" & j & ".xlsx"

ActiveWorkbook.SaveAs Filename:=yourDir & "\Player" & j + 1 & ".xlsx" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End If

Next i


with that function:


Function File_Exists(ByVal sPathName As String) As Boolean
''''''''''''''''''''''''''''''''''''''''
' Function Checking If Filename Exists '
''''''''''''''''''''''''''''''''''''''''
'Returns True if the passed sPathName exist
'Otherwise returns False
If Dir(PathFile) <> "" Then
File_Exist = True
Else
File_Exist = False
End If End Function

[Bob Phillips]

Function File_Exists(ByVal sPathName As String) As Boolean
''''''''''''''''''''''''''''''''''''''''
' Function Checking If Filename Exists '
''''''''''''''''''''''''''''''''''''''''
'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then
File_Exists = (Dir$(sPathName) <> "")
Else
File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If
End Function


As sPathName is not an optional argument, how can it ever be blank as you test for, so how does it ever take the Else path?

[MaximS]

xld you are as always right :)

thanks for your comment otherwise I would never reviewed that function.

it was written by someone else and found in the net at the time when I was just starting my vba adventure. Since then I've used it many times without problem but without you it would stay illogical as it was probably forever.