Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Compare 2 file then move them from directory - VbScript

Status
Not open for further replies.
renangt

renangt

Programmer
Joined
Oct 11, 2019
Messages
3
Location
BR
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 & " )
 
Sort by date Sort by votes
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
 
Upvote 0 Downvote
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 ...
 
Upvote 0 Downvote
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):

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]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

K
  • Locked
  • Question Question
VBSCRIPT dont work windows 11 23h2 ???
Replies
2
Views
1K
SoftwareRT
SoftwareRT
Alexvb6
  • Locked
  • Question Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
913
Alexvb6
Alexvb6
bdwilcox
  • Locked
  • Question Question
Trying to adapt VBScript to search if machine is in an AD group
Replies
8
Views
2K
SoftwareRT
SoftwareRT
paullem
  • Locked
  • Question Question
vbscript to read properties of JPEG file
Replies
4
Views
1K
paullem
paullem
Rick_Stanich
  • Locked
  • Question Question
Save xls file to cvs file
Replies
3
Views
781
Rick_Stanich
Rick_Stanich

Part and Inventory Search

Sponsor

Back
Top