Search code examples
excelvbatextout

Append an existing text file to one I just created in VBA Excel


There are lots of posts on here about appending text generated through Excel to an existing text file, but so far as I can tell, I'm the only one who wants to the do the opposite. I am grabbing a few cells from my excel table and then I would like to append a large amount of static text (let's call it a footer) to this new content.

Sub ExportForSTK()
Dim myFile As String, TargetName As String, rng As Range, i As Integer
Dim Target(2) As String
    For i = 1 To 2 'temporary for working this out
    TargetName = ActiveSheet.Range("B5")
    Filename = TargetName & i & ".t"
    Val1= ActiveSheet.Range("F5")
    Val2 = ActiveSheet.Range("G5")
    ' ... etc.
    myFile = Application.DefaultFilePath & "Filename.txt"
    Open myFile For Output As #1
    Print #1, TextOutput(i)
    'Add contents of footer.txt to the end of Filename.txt
    Close #1
Next i

Obviously I'm missing the big bit about appending footer.txt to Filename.txt. I tried copy pasting footer.txt into the code directly but it's full of quotes and I didn't want to hassle with escaping them all. Is there a way to do this programmatically?


Solution

  • Based on your original code, here is the code you need. It uses a text stream object to hold the contents of the footer text file. You could consider converting all your file i/o to use the FileStreamObject. Would also recommend the use of the FreeFile function which returns the next available file number.

    See:

    Link to: Text Stream Object

    Link to: OpenTextFile Method

    Link to: File System Object

    Sub ExportForSTK()
    
    Dim myFile As String, TargetName As String, rng As Range, i As Integer
    Dim Target(2) As String
    
    Dim strFooterText As String
    Dim fso As Object, tso As Object
    Dim intFileNumber As Integer
    
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    
        ' Get the footer text from the text file one time only
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set tso = fso.OpenTextFile(Application.DefaultFilePath & "\Footer.txt", ForReading, True, TristateFalse)
        strFooterText = tso.ReadAll
        tso.Close
    
        For i = 1 To 2 'temporary for working this out
        TargetName = ActiveSheet.Range("B5")
        FileName = TargetName & i & ".t"
        Val1 = ActiveSheet.Range("F5")
        Val2 = ActiveSheet.Range("G5")
        ' ... etc.
        myFile = Application.DefaultFilePath & "\Filename.txt"
        intFileNumber = FreeFile
        
        Open myFile For Output As #intFileNumber
        
        Print #intFileNumber, TextOutput(i)
        Print #intFileNumber, strFooterText
    
        Close #intFileNumber
    Next i
    
    Set tso = Nothing
    Set fso = Nothing
    
    End Sub