Combining multiple files in to one text using ms access

Question

I have 6 text files in one folder.

I want combine selected files in to one text using access.

I have tried this code without success, because the one text file is created but is empty

Can any one help me on this?

Thanks in advance, my code below.

Lines in the text file:

xN;xDate;xNode;xCO;
100;2017-09-26 00:00:00;Valley;D6;
101;2017-09-25 00:00:00;Valley;D3;
...
...

Code:

Dim xPath
Function xExtract()
    Dim xArray() As Variant
    Dim I As Integer
    Dim StrFileName As String

    xPath = CurrentProject.Path

PDS:
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")

                     new_file = "" & xPath & "\PDS.txt"

                     fn = FreeFile
                     Open new_file For Output As fn
                     Close
                     For I = 0 To UBound(xArray)

                     StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(I) & ".txt"

                      fn = FreeFile
                      Open StrFileName For Input As fn
                      Open new_file For Append As fn + 1

                      Line Input #fn, dato

                      Do While Not EOF(fn)
                        Line Input #fn, dato
                        dati = Split(dato, Chr(9))
                        For d = 0 To UBound(dati)
                            If d = 0 Then
                                dato = Trim(dati(d))
                            Else
                                dato = dato & ";" & Trim(dati(d))
                            End If
                        Next

                        Print #fn + 1, dato

                      Loop
                      Close
                     Next I   

    Application.Quit
End Function

Answer 1

Here's code that works for concatenating comma delimited text files (probably would work for any text files). Pretty crude. Needs error handler and would benefit from common dialog to select output folder and file name. Also I don't like using non-typed variables, but I don't know what type of object some of them are and can't figure it out from Microsoft help. Warning, don't put output in same folder - might result in endless loop - trust me I tried it

Public Function CFiles(Filepath As String) As String

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Folder
    Dim Filein As Object
    Dim fileout As Object
    Dim strText As String
    Dim TheInputfile As Object
    Dim filename As String

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(Filepath)
 
    Set fileout = FSO.CreateTextFile("c:\InvestmentsPersonal\files\backup\output.txt", ForAppending, False)

    
    For Each Filein In SourceFolder.Files
        filename = Filein.Name
        Set TheInputfile = FSO.OpenTextFile(Filepath & filename, ForReading)
        strText = TheInputfile.ReadAll
        TheInputfile.Close
        fileout.WriteLine strText
    Next
    
    fileout.Close
    Set fileout = Nothing
    
    Set Filein = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    CFiles = "c:\InvestmentsPersonal\files\backup\output.txt"

End Function

Answer 2

As your code works for files with windows EOL format (CR (Carriage Return) + LF (Line Feed)), I guess your files are UNIX EOL format (just LF, no CR), check this with a texteditor like e.g. Notepad++ (View->Show Symbol->Show End of Line). This causesLine Inputto read the whole file in one line as it breaks on CR. Then you skip the first line and nothing is inserted, because all text is in this line.

You can useFileSystemObjectto avoid this as it breaks on LF.

Function xExtract()

Const ForReading = 1, ForWriting = 2, ForAppending = 8 'iomode constants
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'format constants
Dim xArray As Variant, dati As Variant
Dim i As Long, d As Long
Dim xPath As String, new_file As String, dato As String, StrFileName As String
Dim FSO As Object, TextStreamIn As Object, TextStreamOut As Object


xPath = CurrentProject.Path
new_file = xPath & "\PDS.txt"

xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")


Set FSO = CreateObject("Scripting.FileSystemObject")

Set TextStreamOut = FSO.OpenTextFile(new_file, ForWriting, True, TristateUseDefault) 'open textstream to write

For i = 0 To UBound(xArray) 'loop through files
    StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(i) & ".txt"

    Set TextStreamIn = FSO.OpenTextFile(StrFileName, ForReading) ' open textstream to read

    TextStreamIn.SkipLine 'skip first line with headers

    Do Until TextStreamIn.AtEndOfStream 'loop through lines
        dati = Split(TextStreamIn.Readline, Chr(9))
        For d = 0 To UBound(dati)
            If d = 0 Then
                dato = Trim(dati(d))
            Else
                dato = dato & ";" & Trim(dati(d))
            End If
        Next
        TextStreamOut.WriteLine dato 'write line to file
    Loop
    TextStreamIn.Close 'close textstream
Next i 'next file

TextStreamOut.Close
Set TextStreamOut = Nothing
Set TextStreamIn = Nothing
Set FSO = Nothing

Application.Quit
End Function

If you want to stay withOpen fileyou can split the first (and only) line on LF (Split(dato,vbLf) and ignore the first element, but you have to check the file is UNIX EOL format, FSO covers both.