Merge text file

[FluFFy05]

Hello, I have 2 text files

1 - c:\t1\clients.txt
"CL14","JACQUES", "RICHARD"
"CL18","RAYMOND", "LIMOGES"
"CL19","CHARLES", "LECLERC"

2 - c:\t2\clients.txt
"CL12","MIKE", "BOSSY"
"CL18","RAYMOND", "LIMOGES"
"CL21","NANCY", "ROLET"
"CL22","BOB", "ROY"

I want to have a single file

3 - c:\client_full.txt

"CL14","JACQUES", "RICHARD"
"CL18","RAYMOND", "LIMOGES"
"CL19","CHARLES", "LECLERC"
"CL12","MIKE", "BOSSY"
"CL21","NANCY", "ROLET"
"CL22","BOB", "ROY"

But I don't want dubbling record

Thanx

 

[Error7]

open "c:\client_full.txt" for append as #1
Open "c:\t1\clients.txt" for input as #2
do while not eof(2)
input #2, R1, R2, R3
write #1, R1, R2, R3
loop
close #2
Open "c:\t2\clients.txt" for input as #2
do while not eof(2)
input #2, R1, R2, R3
write #1, R1, R2, R3
loop
close #2
close #1

That will give you one file called "client_full.txt" containing all the contents of file 1 and file 2.

If you then want to get rid of file 1 and 2 then:
Kill "c:\t1\clients.txt"
Kill "c:\t2\clients.txt"

Alan

[gray]Experience is something you don't get until just after you need it.[/gray]

 

[gmmastros]

There is a faster way. If your data files are large, Alan's method will be slow. Here's an alternative.

    Dim FSO As Scripting.FileSystemObject
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.CreateTextFile("C:\Combined.txt").Write(FSO.OpenTextFile("C:\File1.txt", ForReading).ReadAll & vbCrLf & FSO.OpenTextFile("C:\File2.txt", ForReading).ReadAll)
    Set FSO = Nothing

You will need to add a reference to the Microsoft Scripting Runtime in to your project.



-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[johnwm]

If you only want to concatenate the two text files you don't need FSO. Just use DOS copy via Shell:

Shell ("cmd /c copy c:\client1.txt + c:\client2.txt c:\clients_full.txt")

However if you're looking to remove duplicates then the easiest way may be to use the ADO text driver and deal with them as recordsets, then use a Select Distinct query to remove duplicates.

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Essex Steam UK for steam enthusiasts

 

[gmmastros]

johnwm,

That was my original thought, too. I tried

Shell ("copy c:\client1.txt + c:\client2.txt c:\clients_full.txt")

Without the "cmd /c" and I got an error. Can you explain why that happened. It's not important in the grand scheme of things. I'm just curious.

If you look at the FSO example, you'll notice that I put a vbCrLf in there. When you use your method to add the files together, there is no cr lf, so the last line of the first file runs in to the first line of the second file.


-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[RobSchultz]

I'm pretty sure all of the suggested methods will allow duplicate records to exist. Here is another method...

Private Sub Main()
    Dim allRecs As Collection
    Dim result As Boolean
    Set allRecs = MergeFiles("c:\File1.txt", "c:\file2.txt", "c:\file3.txt", "c:\file4.txt")
    
    result = WriteFile(allRecs, "c:\mergedFile.txt")

End Sub

Public Function MergeFiles(ParamArray fileList() As Variant) As Collection

    On Error Resume Next

    Dim i As Integer, x As Integer
    Dim o
    Dim oFull As Collection
    Set oFull = New Collection
    Dim oFile As Collection
    Set oFile = New Collection
    
    For i = LBound(fileList) To UBound(fileList)
        Set oFile = ReadFile(fileList(i))
        For Each o In oFile
            oFull.Add o, ExtractKey(o)  'will error through if the key (empID) already exists
        Next o
    Next i

    Set MergeFiles = oFull

End Function

Private Function ExtractKey(ByVal record As String) As String
    
    Dim aRecs As Variant
    
    If record = "" Then Exit Function
    aRecs = Split(record, ",")
    
    ExtractKey = Replace(aRecs(0), Chr(34), "")

End Function

Private Function ReadFile(ByVal filePath As String) As Collection
    
    On Error GoTo errHandler
    
    Dim ff As Integer
    Dim empID As String
    Dim firstName As String
    Dim lastName As String
    Dim oRecs As Collection
    Set oRecs = New Collection
    
    ff = FreeFile()
    
    Open filePath For Input As #ff
    Do While Not EOF(ff)
        Input #ff, empID, firstName, lastName
        oRecs.Add BuildRecordString(empID, firstName, lastName), empID
    Loop
    Close #ff
    
    Set ReadFile = oRecs
    
    Exit Function

errHandler:

    If Err.Number = 53 Then 'file not found
        Set ReadFile = oRecs
        Exit Function
    Else
        Resume Next
    End If


End Function

Private Function BuildRecordString(ByVal empID As String, ByVal firstName As String, ByVal lastName As String) As String
    
    BuildRecordString = empID & "," & firstName & "," & lastName

End Function

Private Function BreakString(ByVal record As String, ByRef empID As String, ByRef firstName As String, ByRef lastName As String)
    
    Dim aRec As Variant
    
    If record = "" Then Exit Function
    
    aRec = Split(record, ",")
    empID = aRec(0)
    firstName = aRec(1)
    lastName = aRec(2)

End Function


Private Function WriteFile(ByVal oRecs As Collection, ByVal filePath As String) As Boolean
    
    On Error GoTo errHandler
    
    Dim ff As Integer
    Dim o
    Dim empID As String, firstName As String, lastName As String
    ff = FreeFile()
    
    Open filePath For Output As #ff
    For Each o In oRecs
        Call BreakString(o, empID, firstName, lastName)
        Write #ff, empID, firstName, lastName
    Next o
    Close #ff
    
    WriteFile = True
    
    Exit Function

errHandler:

    On Error Resume Next
    WriteFile = False
    Close #ff
    Exit Function

End Function

Rob

-Focus on the solution to the problem, not the obstacles in the way.-

 

[strongm]

Here's the short version using the filesystemobject and a dictionary (so you'll need a reference to the Microsoft Scripting Runtime):

[blue]Option Explicit

Private Sub Command1_Click()
    MergeAndSave "c:\file3.txt", "c:\file1.txt", "c:\file2.txt"
End Sub

Private Sub MergeAndSave(strTarget As String, ParamArray filelist() As Variant)
    Dim SourceFile As Variant
    Dim TextRecord As Variant
    Dim tempdic As Dictionary
    Set tempdic = New Dictionary
    With New FileSystemObject
        For Each SourceFile In filelist
            For Each TextRecord In Split(.OpenTextFile(SourceFile).ReadAll, vbCrLf)
                On Error Resume Next ' add by exception
                    If TextRecord <> "" Then tempdic.Add TextRecord, TextRecord
                On Error GoTo 0
            Next
        Next
        .CreateTextFile(strTarget).Write Join(tempdic.Items, vbCrLf)
    End With
End Sub[/blue]