File I/O Snippets

[plenderj]

Code Snippets.
All 100% mine. Waha

Give me a mention if you use the code ...

' Clear the contents of a file
'
Private Sub clearFile(ByVal strPath As String)
    If Not Len(Dir(strPath)) = 0 Then
        Open strPath For Output As #1
        Close #1
    End If
End Sub
 
' Is a given string contained within a given file ?
'
Private Function isStringInFile(ByVal strString As String, ByVal strFile As String) As Boolean
    isStringInFile = InStr(returnContents(strFile), strString) <> 0
End Function
 
' Delete a specific line from a file (note: first line = line number 0)
'
Private Sub deleteLine(ByVal strFile As String, ByVal lineNumber As Long)
    Dim strArrBuff() As String, i As Long
    Open strFile For Input As #1
        strArrBuff() = Split(input(LOF(1), 1), vbCrLf)
    Close #1
    Open strFile For Output As #1
        For i = 0 To UBound(strArrBuff)
            If Not i = lineNumber Then Print #1, strArrBuff(i)
        Next
    Close #1
End Sub
 
' Return a specific line number from a file (note: first line = line number 0)
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
    Open strFile For Input As #1
        getLine = Split(input(LOF(1), 1), vbCrLf)(lineNumber)
    Close #1
End Function
 
' Append a line to the end of a file
'
Private Sub appendLine(ByVal strFile As String, ByVal strLineOfText As String)
    Open strFile For Append As #1
        Print #1, strLineOfText
    Close #1
End Sub
 
' Insert a line of text in a file
'
Private Sub insertLine(ByVal strFile As String, ByVal lineNumber As Long, ByVal strLineOfText As String)
    Dim strBuff() As String: strBuff = Split(returnContents(strFile), vbCrLf)
    Dim i As Long
    Open strFile For Output As #1
        For i = 0 To UBound(strBuff)
            If i = lineNumber Then Print #1, strLineOfText
            Print #1, strBuff(i)
        Next
    Close #1
End Sub
 
' Insert a string of text in a file
'
Private Sub insertString(ByVal strFile As String, ByVal writePosition As Long, ByVal strStringOfText As String)
    Dim strBuff As String: strBuff = returnContents(strFile)
    Open strFile For Output As #1
        Print #1, Left(strBuff, writePosition) & strStringOfText & Mid(strBuff, writePosition)
    Close #1
End Sub
 
' Return the contents of a file
'
Private Function returnContents(ByVal strFile As String) As String
    Open strFile For Input As #1
        returnContents = input(LOF(1), 1)
    Close #1
End Function
 
' Return the path of a given full path to a file
'
Private Function returnPathOfFile(ByVal strFile As String) As String
    returnPathOfFile = Left(strFile, InStrRev(strFile, "\"))
End Function
 
' Return the filename of a given full path to a file
'
Private Function returnNameOfFile(ByVal strFile As String) As String
    returnNameOfFile = Mid(strFile, InStrRev(strFile, "\") + 1)
End Function
 
' Split a file up into n byte chunks
'
Private Sub splitUpFile(ByVal strFile As String, ByVal nByteSize As Long)
    Dim strBuff As String: strBuff = returnContents(strFile)
    Dim currPos As Long, endPos As Long: currPos = 1: endPos = Len(strBuff)
    Dim fileNumber As Long
    While currPos <= endPos
        Open Left(strFile, InStrRev(strFile, ".") - 1) & "(" & fileNumber & ")" & Mid(strFile, InStrRev(strFile, ".")) For Output As #1
            If (currPos + nByteSize) > endPos Then
                Print #1, Mid(strBuff, currPos)
            Else
                Print #1, Mid(strBuff, currPos, nByteSize)
            End If
        Close #1
        fileNumber = fileNumber + 1
        currPos = currPos + nByteSize
    Wend
End Sub
 
' Merge a number of source files into a destination file
'
Private Sub mergeFiles(ByVal strDestinationFile As String, ParamArray strSourceFiles())
    Dim i As Long, strBuff As String
    Open strDestinationFile For Output As #1
        For i = 0 To UBound(strSourceFiles)
            Print #1, ""
            Print #1, "***"
            Print #1, "*** " & strSourceFiles(i)
            Print #1, "***"
            Print #1, returnContents(strSourceFiles(i))
        Next
    Close #1
End Sub

[plenderj]

Some much needed updates I suggest you use the following snippets in place of some of the ones above.
This is because if you open a Binary file using the Input mode, it will nearly certainly fail once it hits binary characters.
But if you open for Binary, and use the different input procedure, then you can open both text and binary files.

Using the Get, , #FileNumber is also very fast!

' Return a specific line number from a file (note: first line = line number 0)
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
    Dim strBuff As String
    Open strFile For Binary As #1
        strBuff = Space(Lof(1))
        Get #1, , strBuff
        getLine = Split(strBuff, vbCrLf)(lineNumber)
    Close #1
End Function
 
' Return a specific line number from a file (note: first line = line number 0) - a neater version.
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
    getLine = Split(returnContents(strFile), vbCrLf)(lineNumber)
End Function
 
 
' Delete a specific line from a file (note: first line = line number 0)
'
Private Sub deleteLine(ByVal strFile As String, ByVal lineNumber As Long)
    Dim strArrBuff() As String, i As Long, strFileContent As String
    strArrBuff() = Split(returnContents(strFile), vbCrLf)
    strArrBuff(lineNumber) = vbNullString
    Open strFile For Output As #1
        Print #1, Join(strArrBuff, vbCrLf);
    Close #1
End Sub
 
 
' Return the contents of a file
'
Private Function returnContents(ByVal strFile As String) As String
    Dim strBuff As String
    Open strFile For Binary As #1
        strBuff = Space(Lof(1))
        Get #1, , strBuff
        returnContents = strBuff
    Close #1
End Function

[plenderj]

* 21-October-2004 - Moved to CodeBank *