append to file

[tagteam]

I have a public sub that creates variables and assigns a string length so that I can output a query to a fixed length file. i have copied that public sub so that I can output a slightly different format for another fixed file. I then need to append the second file to the first one.



The sub looks like this

Option Compare Database


Public Type NameofRecord
  VarRecordFormat As String * 1
  VarBillingInvoicingParty As String * 4

Then several more variables

Then I have another public sub

Public Sub OutputTextfile()
Dim rs As DAO.Recordset
Dim objFile As Object, TextFile As Object
Dim TextRecord As NameofRecord
Set rs = CurrentDb.OpenRecordset("q_Export500ByteTable")
Set objFile = CreateObject("Scripting.FileSystemObject")
Set TextFile = objFile.CreateTextFile("E:\tmp\export.txt", True)
Do Until rs.EOF
  With TextRecord
    '.VarRecordFormat = CStr(rs![RecordFormat])
    .VarRecordFormat = Nz(rs![RecordFormat], "")
    .VarBillingInvoicingParty = Nz(rs![BillingInvoicingParty], "")

then more variables here

And then finally at the end

TextFile.WriteLine (.VarRecordFormat & .VarBillingInvoicingParty.. more variable here)
    
  End With
  rs.MoveNext
Loop
rs.Close
TextFile.Close
End Sub

This will write my query out to a file with the correct flat file fixed spacing.

I need to find a way to run four of these processes and have the results be appended to a single file.

I have been able to append to a file using this code:

'the final string to print in the text file
Dim strData As String
'each line in the original text file
Dim strLine As String
strData = ""
'open the original text file to read the lines
Open "E:\tmp\TempTest.txt" For Input As #1
'continue until the end of the file
While EOF(1) = False
    'read the current line of text
    Line Input #1, strLine
    'add the current line to strData
    strData = strData + strLine & vbCrLf
Wend
'add the new line


Dim strModel As String
Dim strSQL As String
Dim rst As DAO.Recordset
strSQL = "SELECT * FROM Record6"
 Set rst = CurrentDb.OpenRecordset(strSQL)
 strModel = rst!BillingInvoicingParty + " " + rst!BilledParty + " " + rst!AccountDate + " " + rst!InvoiceNumber + " " + rst!Currency
rst.Close
Set rst = Nothing  
strData = strData + strModel
Close #1
'reopen the file for output
Open "E:\tmp\TempTest.txt" For Output As #1
Print #1, strData
Close #1
End Sub

What I need is a way to run the first process and write it out to the file, then run the other processes and append the data to that first file.

[ssanfu]

At the top of EVERY module, you should have these two lines:

Option Compare Database
Option Explicit

-----------------------------------------------------------------------
-----------------------------------------------------------------------

From: http://homeandlearn.org/open_a_text_file_in_vba.html

Open path_filename For Mode As FileNumber

The Mode above should be replaced by one of the following:

Append - used for adding data to an already existing file
Output - used to write to a file
Input - used to read a file
Binary - used to read or write data in byte format
Random - used to place characters in a buffer of a set size

If the file specified by pathname doesn't exist, it is created when a file is opened for Append, Binary, Output, or Random modes.

So if the file doesn't exist, using a mode of Append or Output will create the file.

Try this:

Public Sub WriteFiles()
    Dim strLine As String   'each line in the original text file
    Dim fFile As Integer
    Dim strSQL As String
    Dim strModel As String
    Dim txtPathFileName As String
    Dim rst As DAO.Recordset

    fFile = FreeFile  ' Get unused file number.

    txtPathFileName = "E:\tmp\TempTest.txt"

'    'if file exists, delete it first
'    If File_Exist_FSO_Late_binding(txtPathFileName) Then
'        Kill txtPathFileName
'    End If

    Open txtPathFileName For Append As #fFile

    '--------------------------------------------------------------------------
    'File exists and ready to append other data
    '--------------------------------------------------------------------------
    'write second data set  to the text file
    strSQL = "SELECT TOP 1  * FROM tblMyTable"
    Set rst = CurrentDb.OpenRecordset(strSQL)

    strModel = rst!BillingInvoicingParty & " " & rst!BilledParty & " " & rst!AccountDate & " " & rst!InvoiceNumber & " " & rst!Currency
    rst.Close

    'Append data to text file
    Print #fFile, strModel

    '--------------------------------------------------------------------------
    'write third data set  to the text file
    strSQL = "SELECT TOP 1 * FROM Query22"
    Set rst = CurrentDb.OpenRecordset(strSQL)

    strModel = rst!BillingInvoicingParty & " " & rst!BilledParty & " " & rst!AccountDate & " " & rst!InvoiceNumber & " " & rst!Currency
    rst.Close

    'Append data to text file
    Print #fFile, strModel

    '--------------------------------------------------------------------------
    'write fourth data set  to the text file
    strSQL = "SELECT TOP 1  * FROM Query33"
    Set rst = CurrentDb.OpenRecordset(strSQL)

    strModel = rst!BillingInvoicingParty & " " & rst!BilledParty & " " & rst!AccountDate & " " & rst!InvoiceNumber & " " & rst!Currency
    rst.Close

    'Append data to text file
    Print #fFile, strModel

    '--------------------------------------------------------------------------
    'clean up
    Set rst = Nothing
    Close #fFile

End Sub


Function File_Exist_FSO_Late_binding(pPathFileName As String) As Boolean
    'No need to set a reference if you use Late binding
    Dim FSO As Object
    Dim FilePath As String

    Set FSO = CreateObject("scripting.filesystemobject")

    'set default return value
    File_Exist_FSO_Late_binding = False

    If FSO.FileExists(pPathFileName) = True Then
        File_Exist_FSO_Late_binding = True
    End If

End Function