Jul 21, 2009

Split a big xlsx file to several small files


Dim sFSO,sExcelApp,ExBook,NewBook,SourceSheet,NewSheet,oRange
Dim Parameters,fullfilepath,bookcount,sfile
SET Parameters = Wscript.arguments
Set sFSO = CreateObject("Scripting.FileSystemObject")
'If no command line arguments provided, quit
If Parameters.Count = 0 Then
WScript.Quit(1)
Else
fullfilepath = Parameters.item(0)
End If

If fullfilepath = "" or Not Right(fullfilepath,5) = ".xlsx" or Not sFSO.FileExists(fullfilepath) Then
Error=MsgBox("No valid input file provided. Stopping the script now.",vbokonly, "CK")
WScript.Quit(1)
End If

On Error Resume Next 'Resume Error
Set sExcelApp = CreateObject("Excel.Application") 'Create Excel instance
If Err.Number <> 0 Then 
Err.Clear
WScript.Quit(1)
End If

sExcelApp.Workbooks.Open (fullfilepath)
Set ExBook = sExcelApp.ActiveWorkbook
Set SourceSheet = ExBook.worksheets(1)
Set oRange = SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(1, 1)).CurrentRegion
nMaxRow = oRange.Rows.Count
nMaxCol = oRange.Columns.Count
bookcount=int(nMaxRow/50000)+1
'set RangeArray(0) = SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(1, nMaxCol))
sExcelApp.Application.DisplayAlerts = False
    For i = 1 To bookcount
if i=bookcount then 
LastRow=nMaxRow
else
LastRow=50000*i
end if
NewFullFileName=left(fullfilepath,len(fullfilepath)-5) & "_" & i & right(fullfilepath,5)
if sFSO.FileExists(NewFullFileName) then 
set sfile=sFSO.GetFile(NewFullFileName)
sfile.delete
end if

'set RangeArray(1) = SourceSheet.Range(SourceSheet.Cells(LastRow-50000+1, 1), SourceSheet.Cells(LastRow, nMaxCol)).Value
Set NewBook = sExcelApp.Workbooks.Add
Set NewSheet = NewBook.worksheets(1)
NewSheet.Range(NewSheet.Cells(1,1), NewSheet.Cells(1, nMaxCol)).value=SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(1, nMaxCol)).value
NewSheet.Range(NewSheet.Cells(LastRow-50000+1, 2), NewSheet.Cells(LastRow, nMaxCol))=SourceSheet.Range(SourceSheet.Cells(LastRow-50000+1, 1), SourceSheet.Cells(LastRow, nMaxCol)).Value
NewBook.SaveAs (NewFullFileName)
NewBook.Close True
Set NewBook = Nothing
set NewSheet=nothing
Next
ExBook.Close True
If Err.Number = 0 Then Set sfile = sFSO.CreateTextFile(left(fullfilepath,len(fullfilepath)-5) & ".swf", True)
'Wscript.Echo "err:" & Err.Number & left(fullfilepath,len(fullfilepath)-5) & ".swf.txt"
sExcelApp.Application.DisplayAlerts = True
    sExcelApp.Quit
Set sFSO=Nothing
Set sExcelApp=Nothing
set ExBook = Nothing
set sfile=nothing
'**********************************************************************************************************