vbscript - VbScript - 10 個の Excel ファイルがあります。10 個のファイルすべてを 1 つの Excel ファイルに結合したい

Question

VbScript - 10 個の Excel ファイルがあります。10 個のファイルすべてを 1 つの Excel ファイルにマージしたいと考えています。以下のコードは時間がかかります。もっと速く実行する方法はありますか。私は Vbscript の初心者なので、最適化できません。コード。

Sub proc_A
Dim Totfiles(2) 'array of 3 files
Dim FinalFile

Totfiles(0)="C:\POC4.xls"
Totfiles(1)="C:\POC5.xls"
Totfiles(2)="C:\POC6.xls"
'Totfiles(3)="D:\FileD.xls"
FinalFile= "C:\Alerts1.xls"

Call MergeFile(Totfiles,FinalFile)

End Sub    

Function MergeFile(Totfiles,FinalFile)

Dim RowNumber,rowcount
Dim wbookA,wbookD
Dim wsheetA,wsheetD
Dim FinalFileCount  ' To store the row count of final file
'Dim FirstFlag 'To check if the Column name has been copied to final File
'FirstFlag=0  ' IF value is 1 then the Column names will not be copied

set xapp=createobject("excel.application")

For mainloop=0 to Ubound(Totfiles)


  If (mainloop=0) Then  ' This loop is for first file only as it copies Column name
    set wbookA= xapp.workbooks.open(Totfiles(mainloop))
    set wsheetA=wbookA.sheets(1)

    rowcnt=wsheetA.usedrange.rows.count
    colcnt=wsheetA.usedrange.columns.count
    set wbookD= xapp.workbooks.open(FinalFile)
    set wsheetD=wbookD.sheets(1)
    For i=1 to rowcnt
      For j=1 to colcnt

        wsheetD.cells(i,j).value=wsheetA.cells(i,j).value
        wbookD.save

      Next
    Next

  End if

  If (mainloop>0) Then ' This loop is for rest of files. it doesnt copies Column name

aaa= Totfiles(mainloop)
    set wbookB= xapp.workbooks.open(Totfiles(mainloop))
    set wsheetB=wbookB.sheets(1)
    'reading the value from cell

    rowcntB=wsheetB.usedrange.rows.count
    colcntB=wsheetB.usedrange.columns.count
    RowNumber=1
    rowcount=0
    set wbookD= xapp.workbooks.open(FinalFile)
    set wsheetD=wbookD.sheets(1)
    call wsheetD.cells.clear
      Do while(Trim(wsheetD.cells(RowNumber,3).value) <> "")
        log.Message(Trim(wsheetD.cells(RowNumber,3).value))
        RowNumber=RowNumber+1
        rowcount=rowcount+1
      Loop 

    FinalFileCount=rowcount

    for i=1 to rowcntB
      for j=1 to colcntB
        k=FinalFileCount+i
        wsheetD.cells(k,j).value=wsheetB.cells(i+1,j).value
        wbookD.save
      Next
    Next

  End IF

Next  ' End For for main Loop
wbookD.save
wbookD.Close
wbookB.close
set wsheetD =nothing
set wbookD =nothing
set wsheetB =nothing
set wbookB =nothing
set xapp =nothing
MergeFile=True
End Function