Compare 2 file then move them from directory - VbScript

[renangt]

Good night people!

I am new to the forum and I have a doubt this code below needs to read 2 files compare them line by line, after comparing all I have to move them to another directory, go back and read two more and so will even read all the files can help me please.
Obs: I'm sorry if I couldn't open a question like this, I need some urgent help neutral
Following code below:

'###################################################################################
' Autor: Renan
' E-mail:
' Data Criação: 04/10/2019
'###################################################################################
' Objetivo: Compara 2 arquivos .txt linha à linha
'###################################################################################
' Modificações:
'###################################################################################
'on error resume next

'SystemUtil.Run "C:\Scripts\CONVERSOR\ReleaseConversor\ParquetConversor.exe"

ARR = array ("txt")
srcFldr = "C:\Scripts\arquivos\comparar\"
destFldr = "C:\Scripts\arquivos\backup\"
'destFldr = f.GetParentFolderName(WScript.ScriptFullName) & "\"
Set fs1 = CreateObject("Scripting.FileSystemObject")
Set fs2 = CreateObject("Scripting.FileSystemObject")
Set f = fs1.GetFolder(srcFldr)
Set fc = f.Files

For a = 0 To ubound (arr)

For each fs1 in fc
'If Right (f1.name, 3) = arr (a) then f1.copy destFldr
If fs1.name <> "" and Arqu1 = "" Then
Arq1 = fs1.name
PathArq1 = srcFldr & fs1.name
'fs.MoveFile PathArq1, destFldr
End If
For each fs2 in fc
varArq1 = Mid(Arq1, 1, 6)
If Arq1 <> fs2.name and Instr(f2.name, varArq1) Then
Arq2 = fs2.name
PathArq2 = srcFldr & fs2.name
'fs.MoveFile PathArq2, destFldr
Exit for
End If
Next


strArquivo1 = srcFldr & Arq1
strArquivo2 = srcFldr & Arq2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArquivo1 = objFSO.OpenTextFile(strArquivo1, 1)
Set objArquivo2 = objFSO.OpenTextFile(strArquivo2, 1)
Different = 0

nTotalLinha1 = UBound(Split(objFSO.OpenTextFile(strArquivo1).ReadAll, vbLf))
nTotalLinha2 = UBound(Split(objFSO.OpenTextFile(strArquivo2).ReadAll, vbLf))

if ( nTotalLinha2 > nTotalLinha1 ) Then
nTotal = nTotalLinha2
Else
nTotal = nTotalLinha1
End If
' MsgBox "[+] Comparando linhas dos arquivos..."
'Reporter.ReportEvent micPass, Environment("ComparaArquivo"), "[+] Comparando linhas dos arquivos..."
nLinha = 0

Do Until objArquivo2.AtEndOfStream

strLinha2 = objArquivo2.ReadLine
strLinha1 = objArquivo1.ReadLine

' if err.number <> 0 Then strLinha1 = "" End If

If nLinha = nTotal Then
fs1.MoveFile PathArq1, destFldr
fs2.MoveFile PathArq2, destFldr
ElseIf strLinha2 <> strLinha1 Then
Reporter.ReportEvent 1, "comparando arquivos", "Arquivo: " & Arq2 & " - Linha "& nLinha &" : " & strLinha2 & " É diferente!"
Different = 1
ElseIf nLinha = nTotal and Different <> 1 Then
Reporter.ReportEvent 0, "comparando arquivos", "Arquivos: " & Arq1 & " e " & Arq2 & " são Exatamente iguais!"
fs1.MoveFile PathArq1, destFldr
fs2.MoveFile PathArq2, destFldr
End If

nLinha = nLinha + 1

Loop
'fs.MoveFile PathArq1, destFldr
'fs.MoveFile PathArq2, destFldr

Next
Next

Set f = nothing
Set fc = nothing
Set fs1 = nothing
Set fs2 = nothing

'Print "---------------------------------------------"
'Print " Arquivo 1: ( " & nTotalLinha1 & " )"
'Print " Arquivo 2: ( " & nTotalLinha2 & " )

 

[strongm]

If you have

fileex01.txt
fileex02.txt
fileex03.txt
fileex04.txt

what order are you expecting to compare them in? I ask because one might initially assume that you only ever have unique pairs of files to compare - but your post states "go back and read two more and so will even read all the files", which suggest you are expecting more than two files

 

[strongm]

Hello?

 

[renangt]

hello, strongm!

In the directory will have several files with and will always have doubles of files with almost equal names, so i will read 2 files with almost equal names compare them then move them to another directory, go back to the home directory get 2 more with almost identical names and compare them, and so on ...

 

[strongm]

yes, I can see that - my question was really to ensure that you did not have any sort of scenario where MORE than two files might have very similar names, as per my example (which was created specifically as a result of how your posted code currently works which is to try and match the first 6 characters of the file name). Also, your posted code only seems to be trying to move the files IF they are an exact match, but your post suggest you want to move them in either case. Assuminbg the latter, the following is one way of doing it (as ever, please be aware that this is not production code):

[blue]    Dim file1
    Dim file2

    arr = Array("txt")
    srcfldr = "d:\deleteme\source\"
    destfldr = "d:\deleteme\dest\"
    
    With CreateObject("scripting.filesystemobject")
        Set fc = .getfolder(srcfldr).Files
        For a = 0 To UBound(arr)
            For Each f1 In fc
                For Each f2 In fc
                    If f1.Name <> f2.Name And InStr(f2.Name, Mid(f1.Name, 1, 6)) Then
                        file1 = Split(.opentextfile(f1.Path).readall, vbLf)
                        file2 = Split(.opentextfile(f2.Path).readall, vbLf)
                        ntotal = vbsIIf(UBound(file1) > UBound(file2), UBound(file1), UBound(file2))
                        ReDim Preserve file1(ntotal)
                       ReDim Preserve file2(ntotal)
                        For lp = 0 To ntotal
                            If file1(lp) <> file2(lp) Then
                                Wscript.Echo f1 & " Line " & lp + 1 & " is different from " & f2
                                different = True
                            End If
                        Next
                        If Not different Then Wscript.Echo f1 & " & " & f2 & " are an exact match"
                        If Not .FileExists(.BuildPath(destfldr, f1.ShortName)) Then f1.Move .BuildPath(destfldr, f1.ShortName)
                        If Not .FileExists(.BuildPath(destfldr, f2.ShortName)) Then f2.Move .BuildPath(destfldr, f2.ShortName)
                        Exit For
                    End If
                Next
            Next
        Next
    End With
'End Sub

Function vbsIIf(expr, truepart, falsepart)
    vbsIIf = falsepart
    If expr Then vbsIIf = truepart
End Function[/blue]

 

[strongm]

Was this of any use to you?

 

[strongm]

Hello?