Copy most recent file from a batch of alike files using vbscript - vbscript

I am not sure if this is possible or not. I am not even sure where to begin. I have a couple thousand files where the file names are named as so:
nnnnnnnnnnnnnnnn.yyyyddmm.pdf (n = number, yyyy = year, dd = day, and mm = month).
Within these thousands of files, there are batches of alike files that have the same nnnnnnnnnnnnnnnnnn part of the filename but the .yyyyddmm is different in order to represent the date of the file. (These batches of alike files will be merged together at a later point but that is not important to this scenario).
My question is, Is there a way to compare the yyyyddmm part of the alike files and have the most recent date files get copied to a different folder? I need the file that has the most recent date of the alike files on the filename get copied to a different folder.
The reason that I am having issues with this is because I am not sure if it is possible to compare parts of the filename to see which one is in fact the file that has the most recent date. I know that there is a way that this can be done through looking at the date modified date but this will not always give me the alike file with the most recent date.
Any thoughts?? Please let me know if I could provide more information.

Trying to understand your problem/specs. Assume a loop over the files of your .pdf folder results in:
Looking at "0000000000012345.20120402.pdf"
Looking at "0000000000012345.20120502.pdf"
Looking at "0000000000012348.20121702.pdf"
Looking at "0000000000012346.20120802.pdf"
Looking at "0000000000012347.20121002.pdf"
Looking at "0000000000012348.20121602.pdf"
Looking at "0000000000012347.20121302.pdf"
Looking at "0000000000012347.20121202.pdf"
Looking at "0000000000012345.20120202.pdf"
Looking at "0000000000012348.20121502.pdf"
Looking at "0000000000012346.20120602.pdf"
Looking at "0000000000012346.20120902.pdf"
Looking at "0000000000012348.20121402.pdf"
Looking at "0000000000012346.20120702.pdf"
Looking at "0000000000012347.20121102.pdf"
Looking at "0000000000012345.20120302.pdf"
Would
Last file for 0000000000012345 is 0000000000012345.20120502.pdf
Last file for 0000000000012348 is 0000000000012348.20121702.pdf
Last file for 0000000000012346 is 0000000000012346.20120902.pdf
Last file for 0000000000012347 is 0000000000012347.20121302.pdf
identify the files to copy correctly? If yes, say so and I will post the code here.
First, you need a class to obtain and store the info put into the file names:
' cut & store info about file(names) like "0000000000012347.20121202.pdf"
Class cCut
Private m_sN ' complete file name
Private m_sG ' group/number prefix part
Private m_dtF ' date part; converted to ease comparisons
Public Function cut(reCut, sFiNa)
Set cut = Me ' return self/this from function
Dim oMTS : Set oMTS = reCut.Execute(sFiNa)
If 1 = oMTS.Count Then
m_sN = sFiNa
Dim oSM : Set oSM = oMTS(0).SubMatches
m_sG = oSM(0)
m_dtF = DateSerial(oSM(1), oSM(3), oSM(2))
Else
' Err.Raise
End If
End Function ' cut
Public Property Get G() : G = m_sG : End Property ' G
Public Property Get D() : D = m_dtF : End Property ' D
Public Property Get N() : N = m_sN : End Property ' N
End Class ' cCut
Then just loop over the .Files and check the date parts for each group stored in a dictionary (number prefix part used as key):
' The one and only .pdf folder - no recursion into subfolders!
Dim sTDir : sTDir = "..\data\test"
' dictionary to store the last/most recently used file for each group
Dim dicG : Set dicG = CreateObject("Scripting.Dictionary")
' RegExp to cut/parse file names like "0000000000012345.20120402.pdf"
Dim reCut : Set reCut = New RegExp
reCut.Pattern = "^(\d{16})\.(\d{4})(\d{2})(\d{2})\.pdf$"
Dim oFile
For Each oFile In goFS.GetFolder(sTDir).Files
WScript.Echo "Looking at", qq(oFile.Name)
' an oCut object for each file name
Dim oCut : Set oCut = New cCut.cut(reCut, oFile.Name)
If Not dicG.Exists(oCut.G) Then
' new group, first file, assume this is the latest
Set dicG(oCut.G) = oCut
Else
' found a better one for this group?
If dicG(oCut.G).D < oCut.D Then Set dicG(oCut.G) = oCut
End If
Next
WScript.Echo "-----------------------"
Dim sG
For Each sG In dicG.Keys
WScript.Echo "Last file for", sG, "is", dicG(sG).N
Next
WRT comments:
All my (ad hoc/proof of concept) scripts start with
Option Explicit
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
and contain some functions dealing with different aspects/stragegies for a solution to a common problem/topic. When I post code here, I copy/paste working/tested code out of the middle of a function frame like
' ============================================================================
goXPLLib.Add _
"useDic02", "use a dictionary (Mark II)"
' ----------------------------------------------------------------------------
' ============================================================================
Function useDic02()
useDic02 = 1 ' assume error
' The one and only .pdf folder - no recursion into subfolders!
...
Next
useDic02 = 0 ' success
End Function ' useDic02
(yes, there is a first attempt function "useDic()" that was guilty of storing all the oCuts for each group to be processed in a second loop; yes, there is a function "createTestData()" I needed to set up/fill my TDir). Sometimes I'm sloppy and forget about goFS, please accept my apologies.
The variable names are part of an experiment. I used to advocate type-prefixed long variable names upto and including
Dim nIdx
For nIdx = 0 To UBound(aNames)
aNames(nIdx) = ...
Next
Other people argued that nIdx-alikes variables just add some letters to mistype but no additional meaning over i, and that aNames-alikes can't be understood without the context and if you have that, aN would be a just as good remainder for "The first names of the kings of persia from the currently processed file to be compared to the names in the database".
So I thought: Given that there are 3 interesting aspects of a file name (full name to copy, number prefix to group, date part to compare/decide) and that there is half a screen between
Private m_sN ' complete file name
and
Public Property Get N() : N = m_sN : End Property ' N
and given that you need just those 3 properties of the Cut object to use it in
Dim oCut : Set oCut = New cCut.cut(reCut, oFile.Name)
If Not dicG.Exists(oCut.G) Then
' new group, first file, assume this is the latest
Set dicG(oCut.G) = oCut
Else
' found a better one for this group?
If dicG(oCut.G).D < oCut.D Then Set dicG(oCut.G) = oCut
will the average short time memory cope with oCut.D?
Obviously not.
To copy the selected files:
Assuming you want the files copied to an existing folder "..\data\latest", use
goFS.CopyFile goFS.BuildPath(sTDir, dicG(sG).N), "..\data\latest\", True
instead of/in addition to the line
WScript.Echo "Last file for", sG, "is", dicG(sG).N
I did not anticipate that .CopyFile chokes on relative source pathes; so consider replacing the *N*ame property of the cCut class with a *P*ath property.
Trying to use
dicG(sG).Copy "..\data\latest\", True
results in:
Microsoft VBScript runtime error: Object doesn't support this property or method: 'dicG(...).Copy'
because the objects stored aren't files (which have a .Copy method), but cCuts (which don't).

How I would handle it:
I would make a dictionary with for each unique number part a separate key. The value will be an array with all file names sharing that key (and thus sharing the unique number part)
For each key in the dictionary, I will loop through the items in the array, searching for the most recent date.
Approach:
Get a file
Extract number part
See if a key for that number part exist. If not create a key for that number with an empty array as value
Add the filename as a new item to the array
Loop to 1. until all files are handled
Get a key
Get the first file in the attached array. Remember the date and the arrayindex
Get the next file, if the date is higher than the remembered date, update the date to this date and the arrayindex to this array index
Loop to 8. until the end of the array is reached
Store the file with the arrayindex as the most recent file for that unique number
loop to 6. until all keys are handled

Related

Convert string to variable name in VBScript

How can I convert a string to a variable name in VBscript? I found similar Q/A for JavaScript, C#, Pyton, Perl, Ruby, Java, but not for VBscript.
This is why I can not work directly with variables instead of strings:
There is a list of comma separated permission names which I get from a web service. The project manager may update this list any time and expects that I check if a user of software is granted to these permissions. User's permissions are set in run time by complex methods as well as profile data, history of activities in the software etc. e.g. if a user has bought 1000 products, the variable SuperCustomerPermission will set for him in header of page using SuperCustomerPermission="yes" (not as cookies or session nor stored in a databse).
To check the list of permission I want to pass the list of permission names to a function and loop through the names:
Permission names which I get from a web service:
permissionNames = "adminPermission,deletePermission,configPermission,SuperCustomerPermission"
I try to pass these strings as variables to the subroutine:
Sub checkPermission(PermissionNames)
permissionNamesArray = split(permissionNames,",",-1,1)
For Each x In permissionNamesArray
'How to convert x to its variable equivalent and check if it equals "yes"
Next
End Sub
Call checkPermission(permissionNames)
If it is possible to put it into application or session you could do something like session(variableName) = 5.
If not, the next easiest way is using a dictionary:
Dim myDict
Set myDict= CreateObject("Scripting.Dictionary")
myDict.Add (variableName, value)
Using a dictionary should work fine with your situation and it's much cleaner.
That being said, since you asked for an Execute solution, you can do something like this:
Sub checkPermission(PermissionNames)
Dim permissionNamesArray, x
permissionNamesArray = split(permissionNames,",",-1,1)
For Each x In permissionNamesArray
Dim valueOfX
Execute "valueOfX = " & x
WScript.Echo valueOfX
Next
End Sub
Example of usage:
' Adding some values to the variables
Dim adminPermission, deletePermission, configPermission, SuperCustomerPermission
adminPermission = "yes"
deletePermission = "no"
configPermission = "yes"
SuperCustomerPermission = "no"
' Storing names of variables
Dim permissionNames
permissionNames = "adminPermission,deletePermission,configPermission,SuperCustomerPermission"
' Passing variables by names
checkPermission(permissionNames)
Output:
yes
no
yes
no

VBScript code to do math based on folder contents

I could use some help in troubleshooting my code, which should run a report based on files in a folder, which meet certain criteria, read specific lines from those files and sum all the read values. And do some math later on.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
relativePath = wshShell.CurrentDirectory
Set ReportPath = objFSO.GetFolder(relativePath & "\KPI_STATS\")
count = 0
Now I'd like to check each file's filename in ReportPath if it matches current month...
For Each file In ReportPath.files
If instr(LCase(file.name), LCase(Right("0" & DatePart("m",Now),2))) > 0 Then
for i=0 to n
SIDENOTE: Now I don't understand why if I run msgbox(file) for testing only it gives me whole path to the folder with filename instead of filename only.
(let's continue)...and when it does, it should read only 14th line of text (last line and there are only numbers in it) of each file and store it in variable. I use Split for reading certain lines from files and arrays to hold read values but I can use as well something like sum = sum + sum(n-1).
a = Split(objFSO.OpenTextFile(file, ForReading).ReadAll, vbCrLf)
For j = 14
If UBound(a) = j Then
And now I'd like to write those values to separate Arrays
ar(i) = Array(a(j))
End If
Next
next
count = count + 1
End If
Next
I think I will manage to add and divide all the values as soon as I have all arrays in place but there i a problem. It doesn't work :'(
Thanks a lot.

VBScript to combine rs values, loop and add to duplicate(s)

I've written a lot of IF statements in VBScript, but haven't gone much beyond that so apologize for my lack of experience. I hope what I'm asking is simple to do.
I want to output item identifiers created by three combined recordset field values and add "B" "C" "D" etc., to any duplicates. Duplicates are rare, but do happen occasionally. I want to do this for meaningful item identification which autonumbers do not provide.
The following example works to combine fields, but then I need to include script to loop and find the duplicates and add the appropriate alpha character.
FYI: a = alpha character, b = alpha character, c = reformatted date
<% Dim idCode
a = (rs_table.Fields.Item("CodeA").Value)
b = (rs_table.Fields.Item("CodeB").Value)
c = (fixedDate(rs_table.Fields.Item("Date").Value))
idCode = (a) & (b) & (c)
Response.write idCode
%>
example output: LC032414
example dupe output: LC032414B
Thanks, I'm almost afraid to ask and may find this more pain than what it's worth!
I would probably use a Dictionary to store the ID's, since you can add each as a key (which must be unique) and test the Dictionary for its existence. Something like this:
' Early on... create a dictionary...
Set d = CreateObject("Scripting.Dictionary")
' Loop through your records...
Do Until rs_table.EOF
' Determine your ID...
idCode = rs_table("CodeA") & rs_table("CodeB") & fixedDate(rs_table("Date"))
' Check for existence in the dictionary...
If d.Exists(idCode) Then
' ID already exists. Keep testing suffixes until we find an availability...
strLetter = "B"
Do While d.Exists(idCode & strLetter)
strLetter = Chr(Asc(strLetter) + 1)
Loop
d.Add idCode & strLetter, "" ' Add the ID/key. The value is unimportant.
Else
' This ID doesn't exist yet. Just add it.
d.Add idCode, "" ' Add the ID/key. The value is unimportant.
End If
rs_table.MoveNext
Loop
When it comes time to print your ID's, you can just iterate the dictionary's Keys collection:
For Each k In d.Keys
Response.Write k
Next

Word delete blank lines

I would like to clean an auto-generated Word document.
This document contains several tables and there are many blank lines between each of them. I would like to develop a macro that only keeps one blank line between each table.
I don't know if it can be done. Now I'm stuck with:
Dim i As Integer
Dim tTable As Table
For i = 0 To ActiveDocument.Tables.Count
Set tTable = ActiveDocument.Tables.Item(i)
' ???
Next
Any idea?
I found how to do that:
Dim ParagraphToTrim As Range
Dim tTable As Table
Dim aTables() As Table
Set aTables = ActiveDocument.Tables
For Each tTable In aTables
' Supply a Start and End value for the Range.
Set ParagraphToTrim = ActiveDocument.Range(tTable.Range.Next(Unit:=wdParagraph).Start, tTable.Range.Next(Unit:=wdTable).Start)
' Keep at least a paragraph between each table
If ParagraphToTrim.Paragraphs.Count > 1 Then
With ParagraphToTrim
' Change the start of the range
.MoveStart Unit:=wdParagraph
.Delete
End With
End If
Next

Saving a new file with one alphabet preceeding

Please find the code:
Problem is the folder has a large no. of files
=====================================================================================
Dim fso, objFolder, obFileList, folderpath,counter
folderpath = "G:\Everyone\Model Office Testing Documents\HP QC\QTP\PSISAutomation\Logs"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(folderpath)
Set objFileList = objFolder.Files
For Each File In objFileList
msgbox("5")
If InStr(1,File.Name,"DE_For_Pol_Print_APPA_7A_Copy_") = 1 Then
counter=counter+1
End If
Next
counter=counter+1
msgbox("new file will be saved as: " &"DE_For_Pol_Print_APPA_7A_Copy_"& Chr(64 + Counter))
Do not use the FSO, but make use of the WMI where you put the filename in the SELECT statement, like: "DE_For_Pol_Print_APPA_7A_Copy_%". This should return a collection with only files with the requested filename (faster than a total collection).
There is no count property for file collections, but you can use:
For Each file in fileCollection
counter = counter + 1
Next
This will not access the internal file object and should run reasonably fast.
A second and even faster (but uglier imo) technique is to use the command prompt from a windowshell object and return the dir to the output. The output is just a string. Now, count the amount of matches on your desired string (DE_For_Pol_Print_APPA_7A_Copy_) and that is your counter.
The exact code is left blank as an excercise for the poster.

Resources