保存带有连续编号的MS Word文档

时间:2016-01-14 22:33:09

标签: vba ms-word word-vba

@PKatona当我在真实环境中尝试它时,它覆盖了一些文件。在检查代码后,我意识到它正在计算目录中的文件数并保存为下一个数字(比如说文件夹中的第15个文件为' ST14 TC15')而不是保存为下一个数字。文件名(假设目录中只有3个文件,结尾最高的文件是' ST14 TC06'所以下一个文件应该保存为' ST14 TC07'。我希望这样做但是使用你的一些代码我能够想出这个:但是1)必须有办法缩短它! 2)它在Excel中工作(我在那里制作)但是评估'最后一行给出了Sub或函数未定义' Word中的错误!!

再次感谢

`Sub Largest()

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

'*   -   *   -   *
'to put filenames in a 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
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

1 个答案:

答案 0 :(得分:1)

这将找到最后一个文件序列:

Dim filename as String
Dim seq as Integer
seq = 1
filename = Dir("C:\HAPPY\SANTA\ELVES\ST14 TC*.docx")
Do While filename <> ""
    seq = seq + 1
    filename = Dir
Loop

Dim nextFilename as String
nextFilename = "C:\HAPPY\SANTA\ELVES\ST14 TC" + Format(seq, "000") + ".docx"

Add your macro code here...