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个变量/字符串。它使用的模板是一个非常复杂的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份模板。

Version1 FileSystem.FileCopy：创建每个副本的时间：

2.737s
2.722s
2.406s
2.496s

代码：

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

Version2 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

Version3 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

使用稍微不同的文件名创建同一文件的多个副本的最快方法

2 个答案: