Imports a text file into Excel even if the number of lines in that file exceeds Excel's total number of rows limitation.
Visual Basic
' This script was written for folks trying to import a text file into
' Excel 2003 that exceed the row limitations.
' This version works on Windows XP and has not been tested on any other OS.
Const ForReading = 1
Const ForAppending = 2
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "All Files|*.*"
objDialog.InitialDir = "C:\"
intResult = objDialog.ShowOpen
If intResult = 0 Then
Wscript.Quit
Else
BreakFile = objDialog.FileName
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(BreakFile, ForReading)
FiletoSplit = objFSO.GetFileName(BreakFile)
FolderDest = Mid(objFSO.GetAbsolutePathName(BreakFile),1, _
Len(objFSO.GetAbsolutePathName(BreakFile))-(Len(FiletoSplit)))
FileSplitName = objFSO.GetBaseName(BreakFile)
dtmStart = Now()
strContents = objFile.ReadAll
FileNum = 1
fname = FolderDest & FileSplitName & "Split_" & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)
CountLines = 0
arrLines = Split(strContents, vbCrLf)
If ubound(arrLines) < 64500 Then
msgbox "This file will fit into Excel already. No split is necessary.",48,"SplitFile"
Wscript.Quit
End If
HeaderText = arrLines(0)
For i = 0 to ubound(arrlines)
strLine = arrLines(i) & vbCrLf
objFile1.Write strLine
If (Countlines) < 64500 Then
countlines = countlines + 1
ElseIf Countlines >= 64500 Then
objFile1.Close
Countlines = 0
FileNum = FileNum + 1
fname = FolderDest & FileSplitName & "Split_" & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)
objFile1.Write HeaderText & vbCrLf
End If
Next
objFile.Close
dtmEnd = Now()
If MsgBox("There were " & FileNum & " files created." & vbcrlf & _
"The files were put into this folder: " & FolderDest & _
vbCrLf & "The script took " & DateDiff("s", dtmStart, dtmEnd) & " seconds " & _
"to break the " & FiletoSplit & " file." & vbcrlf & vbcrLF & _
"Click OK to open destination folder or CANCEL to quit.", _
1,"SplitFile") = vbOK Then
Set objShell = CreateObject("Shell.Application")
strPath = FolderDest
objShell.Explore strPath
End If
Verified on the following platforms
| Windows Server 2008 R2 | No |
| Windows Server 2008 | No |
| Windows Server 2003 | No |
| Windows 7 | No |
| Windows Vista | No |
| Windows XP | No |
| Windows 2000 | No |
This script is tested on these platforms by the author. It is likely to work on other platforms as well. If you try it and find that it works on another platform, please add a note to the script discussion to let others know.
No comments