I have a folder that I will be looping through to process files differently based on their filenames. Doing good on my script (first one!), until I realized there will be filenames that have also have numbers representing priority. For example in the folder there may be:
'NV_CX67_mainx.dxf'
'NV_CX67_mainx1.dxf'
'NV_CX67_mainx2.dxf '
'NV_CX67_mainxroad.dxf'
'NV_CX67_motx.dxf'
'NV_CX67_resxroad.dxf'
The mainx, mainx1 and mainx2 are the same file type but mainx2 has priority and should be the only one processed. Currently, my statement is:
If Instr(1,FileRef, "mainx",1) then
How might I add a 2nd filter to process only the file with the highest number before moving onto the next file?
You are going to have run through the following process
Sort your input files
Loop through each file one by one
Compare the current file to the previous one you looked at minus the numbers to see if it greater.
Only process an item you have scanned all the similar items to ensure this one has the largest number
I wrote up an example below. Notice only NV_CX67_mainx4.dxf, and NV_CX67_mainxroad.dxf get processed:
Option Explicit
Dim i, sBaseFileName, sPrevFileName, prevBaseFile
sPrevFileName = "~"
prevBaseFile = "~"
Dim arr(5)
'Initialize test array. This will need to be sorted for this code to work properly
arr(0) = "NV_CX67_mainx.dxf"
arr(1) = "NV_CX67_mainx4.dxf"
arr(2) = "NV_CX67_mainx2.dxf"
arr(3) = "NV_CX67_mainxroad.dxf"
arr(4) = "NV_CX67_motx.dxf"
arr(5) = "NV_CX67_resxroad.dxf"
'Loop through the array
For i = LBound(arr) to UBound(arr)
If Instr(1, arr(i), "mainx",1) Then 'Check prev qualifier
sBaseFileName = getsBaseFileName(arr(i))
'First Case
If prevBaseFile = "~" Then
prevBaseFile = sBaseFileName
sPrevFileName = arr(i)
'Tie - Figure out which one to keep based on number at end of file name
ElseIf prevBaseFile = sBaseFileName Then
sPrevFileName = GetMaxFile(sPrevFileName, arr(i))
prevBaseFile = getsBaseFileName(sPrevFileName)
'New Case - Process prev case
Else
'Process File
MsgBox ("Processing " + sPrevFileName)
'Capture new current file for future processing
sPrevFileName = arr(i)
prevBaseFile = getsBaseFileName(sPrevFileName)
End If
End If
Next
'If last file was valid process it
If sPrevFileName <> "~" Then
MsgBox ("Processing " + sPrevFileName)
End If
'Return the larger of the two files based on numbers at end.
'Note "file9.txt" > "file10.txt" in this code
Function GetMaxFile(sFile1, sFile2)
GetMaxFile = sFile1
If sFile2 > sFile1 Then
GetMaxFile = sFile2
End If
End Function
'Return the file without extension and trailing numbers
'getsBaseFileName("hello123.txt") returns "hello"
Function getsBaseFileName(sFile)
Dim sFileRev
Dim iPos
getsBaseFileName = sFile
sFileRev = StrReverse(sFile)
'Get rid of the extension
iPos = Instr(1, sFileRev, ".",1)
If iPos < 1 Then
Exit Function
End If
sFileRev = Right(sFileRev, Len(sFileRev)-iPos)
'Get rid of trailing numbers
Do
If InStr(1, "1234567890", Left(sFileRev, 1), 1) Then
sFileRev = Right(sFileRev, Len(sFileRev)-1)
Else
Exit Do
End If
Loop While(Len(sFileRev) > 0)
getsBaseFileName = StrReverse(sFileRev)
End Function
Related
Kind of new to VBS. I'm trying to count the fields in the file and have this code.
Col()
Function Col()
Const FSpec = "C:\test.txt"
Const del = ","
dim fs : Set fs = CreateObject("Scripting.FileSystemObject")
dim f : Set f = fs.OpenTextFile(FSpec, 1)
Dim L, C
Do Until f.AtEndOfStream
L = f.ReadLine()
C = UBound(Split(L, del))
C = C +1
WScript.Echo "Items:", C
Loop
f.Close
End Function
It works however, I don't want to count the delim inside " ".
Here's file content:
1,"2,999",3
So basically, I'm getting 4 items for now but I wanted to get 3. Kind of stuck here.
For an example of my second suggestion, a very simple example could be something like this. Not saying it is perfect, but it illustrates the idea:
Dim WeAreInsideQuotes 'global flag
Function RemoveQuotedCommas(ByVal line)
Dim i
Dim result
Dim current
For i = 1 To Len(line)
current = Mid(line, i, 1) 'examine character
'check if we encountered a quote
If current = Chr(34) Then
WeAreInsideQuotes = Not WeAreInsideQuotes 'toggle flag
End If
'process the character
If Not (current = Chr(44) And WeAreInsideQuotes) Then 'skip if comma and insode quotes
result = result & current
End If
Next
RemoveQuotedCommas = result
End Function
In one folder I have 10000 files and the the names of files is structured like this:
File1_0, File1_1, File1_2, File1_3
File2_0, File2_1, File2_2
File3_0, File3_1, File3_2, File3_3
...
File1000_0, File1000_1
I like to delete previous revisions of the files and to stay with the last one. Above files to become like this:
File1_3
File2_2
File3_3
....
File1000_1
I am trying the following: Put the name without _xx in an array then to remove the duplicates. But I don't think this is correct and for the moment I am stuck in the logic of the way I should do this.
This is the code:
Option Explicit
Dim fso, folder, sourcefolder, file
Dim b : b = Array()
Dim i
Dim x
Dim z
Dim y
sourcefolder = "C:\test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sourcefolder)
i = 0
For Each file In folder.Files
i = i + 1
x = fso.GetBaseName(file)
ReDim Preserve b(UBound(b) + 1) : b(UBound(b)) = Left(x, Len(x)-2)
y = y & b(i-1) & "#"
Next
z = RemoveDuplicates(y)
For i=0 To UBound(z)-1
WScript.Echo i+1 & " " & z(i)
Next
Function RemoveDuplicates(str)
Dim d
Dim elem
If Trim(str) = "" Then
RemoveDuplicates = Array()
Exit Function
End If
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'make dictionary case-insensitive
For Each elem In Split(str, "#")
d(elem) = True
Next
RemoveDuplicates = d.Keys
End Function
One way to approach your problem is to build a dictionary that maps the basenames of the files to the highest revision number:
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
For Each f In fso.GetFolder(sourcefolder)
basename = fso.GetBaseName(f.Name)
a = Split(basename, "_")
revision = Int(a(UBound(a)))
prefix = a(0)
if d(prefix) < revision Then
d(prefix) = revision
End If
Next
Then run a second loop to remove all files whose basename doesn't have that revision:
For Each f In fso.GetFolder(sourcefolder)
basename = fso.GetBaseName(f.Name)
a = Split(basename, "_")
revision = Int(a(UBound(a)))
prefix = a(0)
If d.Exists(prefix) And revision < d(prefix) Then
f.Delete
End If
Next
Note that this code assumes that the underscore separating prefix and revision is the only one in the basename. If you have filenames containing more than one underscore (like foo_bar_1.txt) you'll need to adjust the extraction of prefix and revision to take care of that.
With that said, I strongly recommend against doing revision management in filenames. Use a revision control system (Git, Mercurial, Subversion, ...). That's what they were invented for.
Option Explicit
' Folder to process
Dim sourceFolder
sourceFolder = "."
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
' Regular expresion used to separate base name and sequence
Dim re
Set re = New RegExp
re.Pattern = "^(.*)_([0-9]+)$"
' Dictionary to store data for each sequence
Dim fileSequences
Set fileSequences = WScript.CreateObject("Scripting.Dictionary")
' fileSequences will use the base name of the files as key and
' hold as data an array with the higher sequence number and the
' associated file full path.
Dim f, colMatches, baseName, sequence
For Each f In fso.GetFolder(sourceFolder).Files
' Try to separate base name and sequence
Set colMatches = re.Execute( fso.GetBaseName(f.Name) )
' Only handle serialized files, those whose name match the regular expresion
If colMatches.Count > 0 Then
' base name and sequence are stored in the Submatches collection
' file extension is included in the base name to avoid handling separate series as one
baseName = LCase( colMatches.Item(0).SubMatches(0) & "." & fso.GetExtensionName( f.Name ) )
' Get the numeric sequence value - This should also handle zero prefixed sequence numbers
sequence = CLng( colMatches.Item(0).SubMatches(1) )
Select Case True
Case Not fileSequences.Exists( baseName )
' New sequence found - store current sequence value and the associated file path
fileSequences.Add baseName, Array( sequence, f.Path )
Case sequence < fileSequences.Item( baseName )(0)
' File with a lower sequence number found - Remove
f.Delete
Case sequence > fileSequences.Item( baseName )(0)
' File with a higher sequence number found - Remove previous one
fso.DeleteFile fileSequences.Item( baseName )(1)
' Update sequence information with new higher value and the associated file path
fileSequences.Item(baseName) = Array( sequence, f.Path )
End Select
End If
Next
This is the middle of the code I'm trying to work with. Is there a way to make the file it's reading open and read from line 2 to line 97? Where I need the correction is starred (****). What I'm trying to do is get the data from lines 2 through 97 to compare to another file I'll have to open from the same lines. The beginning and ends of each file are different but the middle information should match thus I need these specific lines.
' Build Aliquot file name
strFile = aBarcodeExportDir & "A-" & yearStr & "-" & splitStr2(0) & ".csv"
'msgbox("open file: " & strFile)
If (objFS.FileExists(strFile)) Then
' Open A file
Set objFile = objFS.OpenTextFile(strFile)
' Build string with file name minus extension - used later to determine EOF
strFileNameNoExtension = "A-" & yearStr & "-" & splitStr2(0)
' Create dictionary to hold key/value pairs - key = position; value = barcode
Set dictA = CreateObject("Scripting.Dictionary")
' Begin processing A file
Do Until objFile.AtEndOfStream(*****)
' Read a line
strLine = objFile.ReadLine(*****)
' Split on semi-colons
splitStr = Split(strLine, ";")
' If splitStr array contains more than 1 element then continue
If(UBound(splitStr) > 0) Then
' If barcode field is equal to file name then EOF
If(splitStr(6) = strFileNameNoExtension) Then
' End of file - exit loop
Exit Do
Else
' Add to dictionary
' To calculate position
' A = element(2) = position in row (1-16)
compA = splitStr(2)
' B = element(4) = row
compB = splitStr(4)
' C = element(5.1) = number of max positions in row
splitElement5 = Split(splitStr(5), "/")
compC = splitElement5(0)
' position = C * (B - 1) + A
position = compC * (compB - 1) + compA
barcode = splitStr(6) & ";" & splitStr(0) & ";" & splitStr(1) & ";" & splitStr(2)
'msgbox(position & ":" & barcode)
' Add to dictionary
dictA.Add CStr(position), barcode
End If
End If
Loop
' Close A file
objFile.Close
To give the exact answer, we may have to look at your text files(I mean with all the split functions you are using). But, If you just want to compare lines 2-97 of two text files, you can get a hint from the following piece of code:
strPath1 = "C:\Users\gr.singh\Desktop\abc\file1.txt" 'Replace with your File1 Path
strPath2 = "C:\Users\gr.singh\Desktop\abc\file2.txt" 'Replace with your File2 Path
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile1 = objFso.OpenTextFile(strPath1,1)
Set objFile2 = objFso.OpenTextFile(strPath2,1)
blnMatchFailed = False
Do Until objFile1.AtEndOfStream
If objFile1.Line=1 Then
objFile1.SkipLine() 'Skips the 1st line of both the files
objFile2.SkipLine()
ElseIf objFile1.Line>=2 And objFile1.Line<=97 Then
strFile1 = objFile1.ReadLine()
strFile2 = objFile2.ReadLine()
If StrComp(strFile1,strFile2,1)<>0 Then 'textual comparison. Change 1 to 0, if you want binary comparison of both lines
blnMatchFailed = True
intFailedLine = objFile1.Line
Exit Do 'As soon as match fails, exit the Do while Loop
Else
blnMatchFailed = False
End If
Else
Exit Do
End If
Loop
If blnMatchFailed Then
MsgBox "Comparison Failed at line "&intFailedLine
Else
MsgBox "Comparison Passed"
End If
objFile1.Close
objFile2.Close
Set objFile1 = Nothing
Set objFile2 = Nothing
Set objFso = Nothing
I have a problem in that I need to read a specified quantity of characters from a text file, but the specified quantity varies so I cannot use a constant EG:
variable = WhateverIsSpecified
strText = objFile.Read (variable) ' 1 ~ n+1
objOutfile.write strText
NOT
strText = objFile.Read (n) ' n = any constant (interger)
When using the first way, the output is blank (no characters in the output file)
Thanks in advance
UPDATE
These are the main snippets in a bit longer code
Set file1 = fso.OpenTextFile(file)
Do Until file1.AtEndOfStream
line = file1.ReadLine
If (Instr(line,"/_N_") =1) then
line0 = replace(line, "/", "%")
filename = file1.Readline
filename = Left(filename, len(filename)-3) & "arc"
Set objOutFile = fso.CreateTextFile(destfolder & "\" & filename)
For i = 1 to 5
line = file1.Readline
next
nBytes = line 'this line contains the quantity needed to be read eg 1234
Do until Instr(line,"\") > 0
line = file1.ReadLine
Loop
StrData = ObjFile.Read (nBytes)
objOutFile.Write StrData
objOutFile.close
End if
Loop
WScript.quit
My own stupid error,
StrData = ObjFile.Read (nBytes)
should be
StrData = file1.Read (nBytes)
Basically I am trying to write a script to delete files after a certain filename, so based on the below file list
FILE_000001_FULL.ZIP
FILE_000002_FULL.ZIP
FILE_000003_FULL.ZIP
FILE_000004_FULL.ZIP
FILE_000005_FULL.ZIP
FILE_000006_DELTA.ZIP
FILE_000007_DELTA.ZIP
FILE_000008_FULL.ZIP
Everything up until FILE_000005_FULL.ZIP would be deleted. The files are created using a tool and will be sorted by file name, so highest number first. Basically need the 2 latest FULL files kept and the DELTA's (if any) between them. I hope that makes sense.
So far, this is what I have, but just loops constantly, not just until it finds the 2 latest fulls.
Dim fso, folder, files, ToDel, sfolder
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = ("C:\MDS")
Set ToDel = fso.CreateTextFile ("C:\MDS\FileList.txt", True)
Set folder = fso.GetFolder(sFolder)
set files = folder.files
For each folderIDX In files
ToDel.WriteLine(folderidx.Name)
Next
ToDel.close
Dim arrFileLines()
i = 0
Set ObjFile = FSO.OpenTextFile("C:\MDS\FileList.txt", 1)
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
arrFileLines(i) = objFile.ReadLine
i = i + 1
Loop
ObjFile.Close
s = 0
Do While s < 2
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
For Each strLine in arrFileLines
IF InStr(strLine, "FULL") <> 0 Then
wscript.echo "Found Full!!!!"
wscript.echo strLine, s
s = S + 1
End If
Next
Next
LooP
My thoughts was to delete the lines from the text file, then use this text file to delete the files from the directory.
Hopefully that all makes sense and someone can pass some advice on!
You should be able to do this with two iterations through your folder and without the need/use of a text file. During the first pass, record the numbers assigned to the two latest FULL's. Then, in your second pass, delete any files that are less than your second-highest FULL.
Here's how it might look:
' First pass: Find the two latest FULLs...
For Each File In FSO.GetFolder("c:\mds").Files
' Is this a FULL?
If Right(File.Name, 8) = "FULL.ZIP" Then
' Get the numeric value from the file name (6 digits starting as pos 6)...
intNum = CLng(Mid(File.Name, 6, 6))
' Maintain the two latest FULLs...
If intNum > intMax1 Then
intMax2 = intMax1
intMax1 = intNum
ElseIf intNum > intMax2 Then
intMax2 = intNum
End If
End If
Next
' Second pass: Delete anything prior to the second-latest FULL...
For Each File In FSO.GetFolder("c:\mds").Files
intNum = CLng(Mid(File.Name, 6, 6))
If intNum < intMax2 Then File.Delete
Next