Convert large .txt file into smaller .txt files

[robert0803]

Looking to see if there is a way to convert a large .txt file into smaller files within an excel macro. Maybe limit the small files to a 20KB limit. I have an associate that is having trouble manually breaking the files, so I figured if there was a macro that can be created where I can have the info dump into excel and have it break the info into smaller .txt files...this would be a great solution.
Let me know.

 

[Ruddles]

Try this. Create a new workbook, press Alt-F11 to get into VBA, Ctrl-R to view the Project Explorer and go Insert > Module. Replace whatever's there with this code. Set iMaxSize to the size you want for the output files in kilobytes.

Run the code. When the Open dialog box opens, navigate to the file you want to split up. When the Save As box opens, choose a folder and file name for the output files. You can select the same filename as the input file because the output files will have serial numbers appended to the name starting at "0001". I've set the length of the serial number to four digits: if you're planning to produce more than 9999 output files, just change iPadFactor to a larger number.

Let me know how it goes!

[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[SIZE=1][FONT=Courier New]Option Compare Text[/FONT][/SIZE]
 
[FONT=Courier New][SIZE=1]Sub MultiFileSplit()[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1] Const iMaxSize As Long = [COLOR=red][B]20[/B][/COLOR]       [COLOR=green]' how many kbytes in each file[/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New] Const iPadFactor As Integer = 4    [COLOR=green]' how many digits in file name serial number[/COLOR][/FONT][/SIZE]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sInFile As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim inFH As Integer[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sOutFile As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sFolder As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sOutRoot As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sOutExt As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim outFH As Integer[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim sRecord As String[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim iSerialNo As Integer[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim iPtr As Integer[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim iLines As Long[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim iTotal As Long[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim iOutTotal As Long[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Dim dtStart As Date[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sInFile = Application.GetOpenFilename(FileFilter:="All file types (*.*), *.*")[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] If sInFile = "False" Then Exit Sub[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sOutFile = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt")[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] If sOutFile = "False" Then Exit Sub[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] dtStart = Now()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iPtr = InStrRev(sOutFile, ".")[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] If iPtr = 0 Then[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   sOutRoot = sOutFile[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   sOutExt = ""[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Else[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   sOutRoot = Left(sOutFile, iPtr - 1)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   sOutExt = Mid(sOutFile, iPtr)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] End If[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iPtr = InStrRev(sOutRoot, "\")[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sFolder = Left(sOutRoot, iPtr)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iSerialNo = 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Do Until Dir(sOutFile) = ""[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   Kill sOutFile[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   iSerialNo = iSerialNo + 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Loop[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iSerialNo = 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Close[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] inFH = FreeFile()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Open sInFile For Input As #inFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iOutTotal = LOF(inFH)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] outFH = FreeFile()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Open sOutFile For Output As #outFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iLines = 0[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iTotal = 0[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Do Until EOF(inFH)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   Line Input #inFH, sRecord[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   If LOF(outFH) >= iMaxSize * 1024 Then[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     Close #outFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     iSerialNo = iSerialNo + 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     outFH = FreeFile()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     Open sOutFile For Output As #outFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     iLines = 0[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   End If[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   Print #outFH, sRecord[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   iLines = iLines + 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]   iTotal = iTotal + 1[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Loop[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Close #outFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] Close #inFH[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] iPtr = InStrRev(sOutRoot, "\")[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] sOutRoot = Mid(sOutRoot, iPtr + 1)[/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1] MsgBox "Done:-" & Space(15) & vbCrLf & vbCrLf _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & CStr(iTotal) & " records in " & sInFile & " (" & CStr(Int(iOutTotal / 1024)) & "kb)" _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & Space(15) & vbCrLf & vbCrLf _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & CStr(iSerialNo) & " files created: " _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & sFolder & sOutRoot & String(iPadFactor - 1, "0") & "1" & sOutExt _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & "-" & sOutRoot & String(iPadFactor, "0") & CStr(iSerialNo) & sOutExt _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & " (max. " & CStr(iMaxSize) & "kb)" _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & Space(15) & vbCrLf & vbCrLf _[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]     & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), vbOKOnly + vbInformation[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT]
[FONT=Courier New][SIZE=1] [/SIZE][/FONT]
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]

 

[Ruddles]

Oh, one word of warning: when it starts up it clears away any old files it finds in the same folder, i.e. any files with the same type of name as the files you're about to produce. It does this to avoid any confusion but if it's a problem I can rethink that.