Visual Basic Programming Code Examples

Splitting and joining files (used in installation) Often when distribution files you may need to split the files into manageable chunks eg. to fit on a floppy disk. The following routines demonstrate how to split and rejoin files of any type: Option Explicit 'Purpose : Joins the contents of two files together. 'Inputs : sFirstFileName The path and file name of the first file. ' sSecondFileName The path and file name of the first file. ' [sNewFileName] The path and file name of the resulting file. ' If this is not specified then the contents of ' sSecondFileName are appended to sFirstFileName. 'Outputs : Returns True on success. 'Notes : Works with any file format. Function FilesJoin(ByVal sFirstFileName As String, ByVal sSecondFileName As String, Optional ByVal sNewFileName As String) As Boolean Dim abBuffer() As Byte, ihFirstFile As Integer, ihSecondFile As Integer, ihNewFile As Integer Dim bCreateNew As Boolean On Error GoTo ErrFailed 'Open the second file bCreateNew = CBool(Len(sNewFileName)) ihSecondFile = FreeFile Open sSecondFileName For Binary Access Read As #ihSecondFile If bCreateNew Then 'Open first file to read ihFirstFile = FreeFile Open sFirstFileName For Binary Access Read As #ihFirstFile 'Create a New file to hold the contents of the first and second file. ihNewFile = FreeFile Open sNewFileName For Binary Access Write As #ihNewFile 'Read and write the first file to the output file ReDim abBuffer(1 To LOF(ihFirstFile)) Get #ihFirstFile, , abBuffer Put #ihNewFile, , abBuffer 'Read and write the second file to the output file ReDim abBuffer(1 To LOF(ihSecondFile)) Get #ihSecondFile, , abBuffer Put #ihNewFile, , abBuffer Else 'Append the contents of the second file to first file ihFirstFile = FreeFile Open sFirstFileName For Binary Access Write As #ihFirstFile ReDim abBuffer(1 To LOF(ihSecondFile)) Get #ihSecondFile, , abBuffer 'Append to end of file Put #ihFirstFile, LOF(ihFirstFile) + 1, abBuffer End If 'Close files Close #ihFirstFile, #ihSecondFile, #ihNewFile FilesJoin = True Exit Function ErrFailed: Debug.Print "File Split Error: " & Err.Description FilesJoin = False Close #ihFirstFile, #ihSecondFile, #ihNewFile End Function 'Purpose : Splits a file into sections of a specific size 'Inputs : sFileName The path and file name of the file to split. ' lFileSplitSize The size of the individual files to be created by this function (in bytes). ' [bOverwrite] If True overwrites existing files when creating the output files. 'Outputs : Returns the number of files it created or -1 on error. 'Notes : Works with any file format. ' An example of the output files created is: ' Original file name "C:\Test.txt" ' Output files "C:\Test.txt.1", "C:\Test.txt.2" etc Function FileSplit(ByVal sFileName As String, ByVal lFileSplitSize As Long, Optional bOverwrite As Boolean = False) As Long Dim abBuffer() As Byte, ihFile As Integer, ihNewFile As Integer, lThisByte As Long, lFileBytes As Long On Error GoTo ErrFailed 'Open the file ihFile = FreeFile Open sFileName For Binary Access Read As #ihFile lFileBytes = LOF(ihFile) ReDim abBuffer(1 To lFileSplitSize) For lThisByte = 1 To lFileBytes Step lFileSplitSize 'Read data in from existing file Get #ihFile, lThisByte, abBuffer 'Open output file ihNewFile = FreeFile FileSplit = FileSplit + 1 If bOverwrite Then If Len(Dir$(sFileName & "." & FileSplit)) > 0 Then 'File exists, delete it Kill sFileName & "." & FileSplit End If End If Open CStr(sFileName & "." & FileSplit) For Binary Access Write As #ihNewFile 'Write data to output file Put #ihNewFile, , abBuffer 'Close output file Close #ihNewFile Next Close #ihFile Exit Function ErrFailed: Debug.Print "File Split Error: " & Err.Description FileSplit = -1 Close #ihFile, #ihNewFile End Function 'Demonstration routine 'Splits a file and joins it back together Sub Test() Dim lNumFiles As Long, lThisFile As Long 'Split a file into sections of 10 kb lNumFiles = FileSplit("C:\Test1.txt", 10 * 1024, True) '10 kb per file 'Rejoin the files For lThisFile = 1 To lNumFiles FilesJoin "C:\Test New.txt", "C:\Test1.txt." & lThisFile Next End Sub