Import a Large Text File

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.

Share this

ChinniLax