é o seguinte agora que li sua mensagem anterior, faça a seguinte alteração
Public Function ComparaTXT(OriginalTXT As String, CompararTXT As String, NovoTXT As String)
Dim Arq1 As Integer
Dim Arq2 As Integer
Dim Arq3 As Integer
Dim OrigLine As String ' Linha Original
Dim CompLine As String ' Linha de Comparação
Arq1 = FreeFile
Open OriginalTXT For Input As #Arq1 ' abre o primeiro arquivo
Arq3 = FreeFile
Open NovoTXT For Output As #Arq3 ' abre o segundo arquivo
Do While Not EOF(Arq1) 'Inicia o Loop no arquivo1
Line Input #Arq1, OrigLine ' grava a linha em OrigLine
Arq2 = FreeFile
Open CompararTXT For Input As #Arq2 'Abre o arquivo 2
Do While Not EOF(Arq2) ' inicia um novo Loop dentro do primeiro Loop
Line Input #Arq2, CompLine ' salva a linha em CompLine
If InStr(1, OrigLine, CompLine) <> 0 Then
Print #Arq3, CompLine ' grava somente o que for encontrado no arquivo 3
List1.AddItem CompLine
End If
Loop
Close #Arq2
Loop
Close #Arq1
Close #Arq3
End Function
Private Sub Command1_Click()
' palavra chave = 4 aqui você pode colocar um código especifico
ComparaTXT "c:\teste1.txt", "c:\teste2.txt", "c:\teste3.txt"
End Sub
agora sim crio que esteja do jeito que você deseja
faça o teste, ele vai comparar a sequencia do arquivo um com o arquivo dois e gravar somente as que são indenticas
