创建文件名略有不同的同一文件的多个副本的最快方法

Question

我目前正在做以下事情：

Global myNames() As Variant

Sub createEmptyTemplates(ByVal destPath As String, ByVal tempPath As String)

':: this is just to create a load of copies of a template

Dim aName
For Each aName In myNames()

    Dim myDest As String
    myDest = destPath & "\" & "Copy of template named - " & aName & ".xlsx"

    FileSystem.FileCopy tempPath, myDest

Next aName 

End Sub

之前这个子程序调用变体数组myNames()填充200个variant/strings。它使用的模板非常复杂 excel 文件。

创建完所有文件后，它会继续执行进一步的例程，打开每个文件并导入相关数据。

上面的例程不是那么快 - 总共可能需要 5 分钟。有没有更有效的方法来创建所有这些文件副本？

Answer 1

你考虑过吗？

Sub M_snb()
  sn=array("name1", "name2",....,"")

  for each it in sn
   thisworkbook.savecopyas "G:\OF\" & it & ".xlsx"
  next
End Sub

Answer 2

经过测试并得到相当令人惊讶的结果，表明使用 filesystemObject 比我测试的其他两种方法要好得多。

模板大约为 2000KB。我限制了运行只有 4 个模板副本。

版本 1 FileSystem.FileCopy：创建每个副本的次数：

2.737s
2.722s
2.406s
2.496 秒

代码：

Global myNames() As Variant

Sub createEmptyTemplates(ByVal destPath As String, ByVal templateFullPathName As String)

':: this is just to create a load of copies of a template

Dim aName
For Each aName In myNames()

    Dim myDest As String
    myDest = destPath & "\" & "Copy of template named - " & aName & ".xlsx"

    FileSystem.FileCopy tempPath, myDest

Next aName 

End Sub

版本 2 Scripting.FileSystemObject.CopyFile（带有早期绑定参考）：创建每个副本的时间：

0.244s
0.084s
0.093s
0.080s

代码：

 Global myNames() As Variant

    Sub createEmptyTemplates(ByVal destPath As String, ByVal templateFullPathName As String)

    ':: this is just to create a load of copies of a template

    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    Dim aName
    For Each aName In myNames()

        Dim myDest As String
        myDest = destPath & "\" & "Copy of template named - " & aName & ".xlsx"

        fso.CopyFile _
           Source:=templateFullPathName, _
           Destination:=myDest

    Next aName 

    If Not (fso Is Nothing) Then Set fso = Nothing
    End Sub

版本 3 wbObjVar.SaveCopyAs：创建每个副本的次数：

3.348s
3.740s
3.179s
3.418s

代码：

Global myNames() As Variant

Sub createEmptyTemplates(ByVal destPath As String, ByVal templateFullPathName As String)

':: this is just to create a load of copies of a template

Dim t As Excel.Workbook
Set t = Excel.Workbooks.Open(templateFullPathName, , False, , , , True)

Dim aName
For Each aName In myNames()
    t.SaveCopyAs  destPath & "\" & "Copy of template named - " & aName & ".xlsx"
Next aName 

If Not (fso Is Nothing) Then Set fso = Nothing
End Sub

创建文件名略有不同的同一文件的多个副本的最快方法

Quickest way to create multiple copies of the same file with slightly different file names

filesystems

excel

vba