Saving MS Word files with consecutive numbering

[Tarumar7]

I would appreciate any help with this macro.

What I'm trying to accomplish is with the help of a macro to be able to save an open file (there will be many!) to the
same directory with a consecutive number. With some help I have come up with the following code that checks a certain directory
for the highest number used in the file and saves with the consecutive number (e.g. say the files in the certain directory are
ST14 HP002, ST14 HP056 and ST14 HP087, so it will save the next file as ST14 HP088 and so on). I have made this macro in excel vba editor
(could probably be done with much fewer lines but works fine in Excel) thinking it would also work in Word but for some reason Word
doesn't recognize:
'num(Counter) = Evaluate(str(Counter))' and
'dblMax = Application.WorksheetFunction.Max(num())'

Also would there be a way to ask for a (create new if necessary) directory when the macro is run the first time for the first file to be saved as
ST14 HP001.

Thank you




Sub fileSaveConsecutive()

Dim dblMax As Double
Dim var_data(200)
Dim var_numdata(200)

'* - * - *
'to put our filenames in our specific directory into an array
Dim MyFile As String
Dim Counter As Long

'Create a dynamic array variable, and then declare its initial size
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)
Dim str()
ReDim str(1000)
Dim num()
ReDim num(1000)

'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$("C:\HAPPY\SANTA\ELVES\*.docx")
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
str(Counter) = Mid(DirectoryListArray(Counter), 8, 3)
num(Counter) = Evaluate(str(Counter))
Counter = Counter + 1
Loop

'Reset the size of the array without losing its values by using Redim Preserve
ReDim Preserve DirectoryListArray(Counter - 1)
ReDim Preserve str(Counter - 1)
ReDim Preserve num(Counter - 1)

dblMax = Application.WorksheetFunction.Max(num())

Dim nextFilename As String
nextFilename = "C:\HAPPY\SANTA\ELVES\ST14 HP" + Format((dblMax + 1), "000") + ".docx"

ActiveDocument.SaveAs filename:=nextFilename
ActiveDocument.Close


End Sub

[Tarumar7]

I was able overcome the 'Evaluate' problem by using CInt in the previous line:

str(Counter) = CInt(Mid(DirectoryListArray(Counter), 8, 3))

and get rid of num() all together.

As for 'dblMax = Application.WorksheetFunction.Max(num())' issue, I started Excel Application Object before this line
and it is working though quiet slowly!

Dim excelapp As Object
Set excelapp = CreateObject("Excel.Application")
'assign the highest value in the array to dblMax
dblMax = excelapp.Worksheetfunction.max(NumbersListArray())
excelapp.Quit

Still any efforts to simplify and speed up this code would be much appreciated.

Thank you.

[akuini]

Hi, Tarumar7
You may try this code:

Sub fileSaveConsecutive1()
Dim a As Long
Dim b As Long
Dim c As String
Dim MyFile As String

b = 0
MyFile = Dir$("C:\HAPPY\SANTA\ELVES\*.docx")
Do While MyFile <> ""
a = Mid(MyFile, 8, 3)
If a > b Then b = a
MyFile = Dir$
Loop
b = b + 1

If b < 10 Then
c = "00" & b
ElseIf b > 9 And b < 100 Then
c = "0" & b
Else
c = b
End If

ActiveDocument.SaveAs FileName:="C:\HAPPY\SANTA\ELVES\ST14 HP" & c & ".docx"
ActiveDocument.Close
End Sub

[gmayor]

See the CreateFolders function and the FileNameUnique function at http://www.gmayor.com/useful_vba_functions.htm

[Tarumar7]

Thank you akuini and thank you gmayor. akuini I found a way to speed up the macro by turning on the Excel Library in the Tools/References of the VBA editor. I turned the Access library for good measure which added some more nice possibilities.
But later found out to watch out for certain issues; for example now there were three Application.etc commands and the one I wanted was not listed! Later figured out that since there are three of them one must specify Excel.Application.etc and so on in the code. gmayor some very useful file/folder examples on that site. Thank you.

[akuini]

Hi, Tarumar
Can you please show your code here? It sounds interesting, maybe I and other people can learn something from it.
Just curious, why do you need Excel.Application to do the job while Word can do it too? Is it faster?