Abstract
Sometimes you need to divide a file into smaller chunks to be able to process them one by one.
Imagine you have three identical input files like
which you need to split into smaller chunks like
Then you can use this application:
Note: This application can also serve as a first sample application for any introduction into VBA because it is short and it makes efficient use of two useful VBA classes: SystemState and Logging.
Appendix – Split_CSV_Files Code
Please note that this program requires (uses) the VBA classes SystemState and Logging which you can find at SystemState and at Logging.
Please read my Disclaimer.
Option Explicit
'Source (EN): http://www.sulprobil.de/split_csv_files_en/
'Source (DE): http://www.berndplumhoff.de/split_csv_files_de/
'(C) (P) by Bernd Plumhoff 13-Sep-2022 PB V1
Public Const AppVersion As String = "Split_CSV_Files_Version_1"
Sub Split_CSV_Files()
Dim FSO As Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim FileItem As Scripting.File
Dim FileIn As Integer
Dim FileOut As Integer
Dim i As Long
Dim lFatal As Long
Dim lSize As Long
Dim lFileSize As Long
Dim lWarn As Long
Dim s As String
Dim sDataLine As String
Dim sDir As String
Dim sSeparationRecordPrefix As String
Dim state As SystemState
Set state = New SystemState
If GLogger Is Nothing Then Call auto_open
GLogger.SubName = "Split_CSV_Files"
GLogger.ever String(200, "-")
GLogger.ever "Program run started with version " & AppVersion
sSeparationRecordPrefix = Range("SeparationRecordPrefix")
lFileSize = Range("FileSize")
GLogger.info "SeparationRecordPrefix = '" & sSeparationRecordPrefix & _
"', FileSize = " & Format(lFileSize, "#,##0")
If Dir(ThisWorkbook.Path & "\Output\", vbDirectory) = "" Then
MkDir ThisWorkbook.Path & "\Output\"
GLogger.info "Created folder " & ThisWorkbook.Path & "\Output\"
End If
On Error Resume Next
Kill ThisWorkbook.Path & "\Output\*.*"
On Error GoTo 0
sDir = ThisWorkbook.Path & "\Input"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(sDir)
For Each FileItem In Folder.Files
s = "Processing input file " & FileItem.Name & " with file size " & _
Format(FileItem.Size, "#,##0")
Application.StatusBar = s
GLogger.info s
FileIn = FreeFile()
Open ThisWorkbook.Path & "\Input\" & FileItem.Name For Input As #FileIn
i = 1
lSize = 0
FileOut = FreeFile()
Application.StatusBar = s & ", output file '" & ThisWorkbook.Path & _
"\Output\" & i & "_" & FileItem.Name & "'"
GLogger.info s & ", output file '" & ThisWorkbook.Path & _
"\Output\" & i & "_" & FileItem.Name & "'"
Open ThisWorkbook.Path & "\Output\" & i & "_" & FileItem.Name _
For Output As #FileOut
Do While Not EOF(FileIn)
Line Input #FileIn, sDataLine
If lSize >= lFileSize Then
If Left(sDataLine, Len(sSeparationRecordPrefix)) = sSeparationRecordPrefix Then
Close #FileOut
i = i + 1
lSize = 0
Application.StatusBar = s & ", output file '" & ThisWorkbook.Path & _
"\Output\" & i & "_" & FileItem.Name & "'"
GLogger.info s & ", output file '" & ThisWorkbook.Path & _
"\Output\" & i & "_" & FileItem.Name & "'"
FileOut = FreeFile()
Open ThisWorkbook.Path & "\Output\" & i & "_" & _
FileItem.Name For Output As #FileOut
End If
End If
Print #FileOut, sDataLine
lSize = lSize + Len(sDataLine)
Loop
Close #FileIn
Close #FileOut
Next FileItem
If lWarn > 0 Or lFatal > 0 Then
Call MsgBox("Program run finished with" & vbCrLf & _
lWarn & " warnings and with" & vbCrLf & _
lFatal & " errors.", vbOKOnly, _
"Warning")
End If
GLogger.ever "Program run version " & AppVersion & " finished with " & _
lWarn & " warnings and with " & lFatal & " errors."
End Sub
Please read my Disclaimer.
Split_CSV_Files_v1.xlsm [64 KB Excel file, open and use at your own risk]