but instead to save into the same file the splited small file how to save into a sub dir from source?
i need to store the little files in: "C:\Lavori_Vb6\STRADARIO\FILE\SPLITED_FILE\....
Code: Select all
Option Explicit
Private Const INPUT_TEXT_FILE = "C:\Lavori_Vb6\STRADARIO\FILE\it_countrywide-addresses-country.TXT" 'The full path to the big file
Private Const REPEAT_HEADER_ROW = True 'Set to True to duplicate the header row in each part file
Private Const LINES_PER_PART = 30000 'The number of lines per part file
Public Sub SPLITFILE()
Dim oFileSystem, oInputFile, oOutputFile, iOutputFile, iLineCounter, sHeaderLine, SLINE, sFileExt, sStart
sStart = Now()
sFileExt = Right(INPUT_TEXT_FILE, Len(INPUT_TEXT_FILE) - InStrRev(INPUT_TEXT_FILE, ".") + 1)
'Debug.Print sFileExt
iLineCounter = 0
iOutputFile = 1
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
Set oInputFile = oFileSystem.OpenTextFile(INPUT_TEXT_FILE, 1, False)
Set oOutputFile = oFileSystem.OpenTextFile(Replace(INPUT_TEXT_FILE, sFileExt, "_" & iOutputFile & sFileExt), 2, True)
'Debug.Print INPUT_TEXT_FILE
If REPEAT_HEADER_ROW Then
iLineCounter = 1
sHeaderLine = oInputFile.ReadLine()
Call oOutputFile.WriteLine(sHeaderLine)
End If
Do While Not oInputFile.AtEndOfStream
SLINE = oInputFile.ReadLine()
Call oOutputFile.WriteLine(SLINE)
iLineCounter = iLineCounter + 1
If iLineCounter Mod LINES_PER_PART = 0 Then
iOutputFile = iOutputFile + 1
Call oOutputFile.Close
Set oOutputFile = oFileSystem.OpenTextFile(Replace(INPUT_TEXT_FILE, sFileExt, "_" & iOutputFile & sFileExt), 2, True)
If REPEAT_HEADER_ROW Then
Call oOutputFile.WriteLine(sHeaderLine)
End If
End If
Loop
Call oInputFile.Close
Call oOutputFile.Close
Set oFileSystem = Nothing
Call MsgBox("Done" & vbCrLf & "Lines Processed:" & iLineCounter & vbCrLf & "Part Files: " & iOutputFile & vbCrLf & "Start Time: " & sStart & vbCrLf & "Finish Time: " & Now())
End Sub