VBScript to copy/move file by lowest value in filename - vbscript

I'm fairly new to scripting and am in need of some help. I have come across a unique situation for a Non-Profit client of ours that requires us to compare two or more files in a specific folder and move the file with the lowest numerical value in the filename.
This organization runs a non-profit radio station which has content submitted from hundreds of volunteers that name their files (when they record more than one) with various numbers at the end that either represent the date or the order in which the files are to be aired.
Essentially I am looking to create a vbscript (because I think it can be done this way) that will run with windows task scheduler 30 minutes prior to the first air date of the content and move the file with the lowest value (if more than one file exists) to a folder where it will be automatically processed by the radio automation software.
Examples of files in a folder might look something like these:
Folder1: (in this instance, "news.mp3" is the lowest value)
news.mp3
news1.mp3
news2.mp3
Folder2:
entertainment24.mp3
entertainment26.mp3
Folder3:
localnews081420.mp3
localnews081520.mp3
Honestly, on this one, I'm not even sure where to start. I've found several scripts that can look at file date or a specific numerical or date format in the filename, but none that can parse numbers from a filename and move/copy a file based on the numerical value. I'm hoping there is someone out there smarter than me that can point me in the right direction. Thanks for looking at my problem!
One script I've been playing with (from the scripting guy) looks at specific years in a filename:
strComputer = “.”
Set objWMIService = GetObject(“winmgmts:\\” & strComputer & “\root\cimv2”)
Set colFiles = objWMIService.ExecQuery _
(“ASSOCIATORS OF {Win32_Directory.Name=’C:\Test’} Where ” _
& “ResultClass = CIM_DataFile”)
Set objRegEx = CreateObject(“VBScript.RegExp”)
For Each objFile in colFiles
objRegEx.Global = True
objRegEx.Pattern = “\d{4}”
strSearchString = objFile.FileName
Set colMatches = objRegEx.Execute(strSearchString)
strYear = colMatches(0).Value
strNewFile = “C:\Test\” & strYear & “\” & objFile.FileName & _
“.” & objFile.Extension
objFile.Copy(strNewFile)
objFile.Delete
Next
...but I can't seem to make the leap to regular numbers and then take a lowest value...

You can use FileSystemObject to Work with Drives, Folders and Files.
Also i used GETNUM function to get number.
Try my way :
sFolder = "C:\Test\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile in oFSO.GetFolder(sFolder).Files
Number=GETNUM(objFile.Name)
strNewFile = sFolder & Number & "\" & objFile.Name
If NOT (oFSO.FolderExists(sFolder & Number)) Then
oFSO.CreateFolder(sFolder & Number)
End If
oFSO.MoveFile objFile, strNewFile
Next
Function GETNUM(Str)
For i=1 To Len(Str)
if IsNumeric(Mid(Str,i,1)) Then
Num=Num&Mid(Str,i,1)
End if
Next
GETNUM=Num
End Function
For understanding the used code and how they work, open these sites and read all pages very carefully.
MoveFile method
Vbs Script to check if a folder exist

Related

VBS Readline - using instr(), to match data whilst ignoring extra spaces

I'm trying to find a way to enhance the reliability of my script. It already works but can be thrown off with a simple extra space in the imported text file.
So I'd like to change my script to Readline if I can find a way to do something like:
Example of text in the .txt file:
FLIGHTS OVER TUSKY PLEASE FILE:
AT OR WEST OF A LINE RBV..LLUND..BAYYS..PUT..DIRECT
FLIGHTS OVER EBONY PLEASE FILE:
AT OR WEST OF A LINE RBV..LLUND..BAYYS..PUT..DIRECT
I know the following doesn't work but if there was a simple modification this would be good.
set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("C:\Downloads\software\putty.exe -load "testing")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\AW\Desktop\Entries1.txt")
strLine = objFile.ReadAll
If InStr(strLine1, "OVER TUSKY PLEASE") and InStr(strLine2, "BAYYS..PUT..DIRECT") Then
trans307="TUSKY"
ind306="4"
WHAT I'M USING NOW:
I edit the text file in notepad++ to FIND & REPLACE "\n" with "" and "\r" with " " and then it's all one text string and I search for strings within that string.
If InStr(strLine, "FLIGHTS OVER TUSKY PLEASE FILE: AT OR WEST OF A LINE ..RBV..LLUND..BAYYS..PUT..DIRECT") _
or InStr(strLine, "FLIGHTS OVER TUSKY PLEASE FILE: AT OR WEST OF A LINE RBV..LLUND..BAYYS..PUT...DIRECT") Then
trans308C="TUSKY"
ind308C="4"
Problem: If the creators of the text file put another space " " anywhere in this line "AT OR WEST OF A LINE RBV..LLUND..BAYYS..PUT..DIRECT" the script will not identify the string. In the above example I have had to create another or InStr(strLine, "") statement with an extra space or with a couple of dots.
UPDATE:
I will try something like:
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\AW\Desktop\Entries1.txt")
strLine1 = objFile.Readline(1)
strLine2 = objFile.Readline(2)
If InStr(strLine1, "FLIGHTS OVER TUSKY") and InStr(strLine2, "RBV..LLUND..BAYYS..PUT..DIRECT") Then
trans1="TUSKY"
ind1="4"
and see if I can get that to read 2 lines at a time, and loop through the text file.
If you're scared of regex and looking for an alternative, you could create a clunky function to add to your script. Based on your samples, it would seem that fullstops are also never normally used for normal purposes and tend to represent spaces. (I would recommend using Regex instead!)
Using these presumptions, you could create a clunky function like this, that looks for fullstops, and converts them to spaces, removing extra spaces.. Obviously, this relies heavily on your input source files not changing too much - you really should be using a regex to work this stuff out properly.
You could test for the basic expected results using something like the function below.
For example say you had a line of text set in firLine with multiple spaces or fullstops, the function would recognize this:
firLine = "THIS.IS.A.TEST..YOU...SEE MULTIPLE SPACES"
if instr(sanitize(firLine),"THIS IS A TEST YOU SEE MULTIPLE SPACES") then
wscript.echo "Found it"
End If
Here's the clunky function that you could just paste at the end of your script:
Function sanitize(srStr)
Dim preSanitize, srC, spaceMarker
preSanitize = ""
for srC = 1 to len(srStr)
if mid(srStr, srC, 1) = "." then
preSanitize = preSanitize & " "
else
preSanitize = preSanitize & mid(srStr, srC, 1)
End If
spaceMarker = false
sanitize = ""
for srC = 1 to len(preSanitize)
If mid(preSanitize, srC, 1) = " " then
if spaceMarker = false then
sanitize = sanitize & mid(preSanitize, srC, 1)
spaceMarker = true
End If
else
sanitize = sanitize & mid(preSanitize, srC, 1)
spaceMarker = false
End If
Next
End Function
InStr() is a good tool for checking whether a strings contains a fixed/literal string or not. To allow for variation, you should use Regular Expressions (see this or that).
First of all, however, you should work on your specs. Describe in plain words and with some samples what you consider (not) to be a match.
E.g.: A string containing the words "FLIGHTS", "OVER", and "TUSKY" in that order with at least one space in between is a match - "FLIGHTS OVER TUSKY", "FLIGHTS OVER TUSKY"; "FLIGHTS OVER TUSKANY" is a 'near miss' - what about "AIRFLIGHTS OVER TUSKY"?
GREAT NEWS! I finally figured out how to do this.
Here is a snippet from "Entries1.txt"
FLIGHTS OVER BRADD KANNI PLEASE FILE:
VIA J174.RIFLE..ACK..DIRECT
OR RBV.J62.ACK..DIRECT
FLIGHTS OVER KANNI WHALE PLEASE FILE:
VIA J174.RIFLE..ACK..DIRECT OR
FLIGHTS OVER WHALE PLEASE FILE:"
ETC, ETC
set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\AW\Desktop\Entries1.txt")
Do until objFile.AtEndOfStream
firLine = objFile.ReadLine
If InStr(firLine, "FLIGHTS OVER KANNI WHALE PLEASE") Then
secLine = objFile.ReadLine
If InStr(secLine, "J174.RIFLE..ACK..DIRECT") Then
'I'm going to change the below once I piece it all together.
WScript.Echo "works"
Else WScript.Echo "Not found"
'cut, paste and modify all my "IF" statements below
End If
End If
loop

vbscript error path not found while using movefolder method

I am fairly new to vbscript, and attempting to write a script that will pick up month and year stamped folders (2012_04) and move them to a year stamped folder (2012). I am getting a Path not found error though when I attempt to move the folder, and I can't seem to find an answer anywhere as to why it is happening.
for i = 0 to UBound(yearArray)
Set folder = fso.GetFolder(InputP)
Set subFold = Folder.Subfolders
yearStamp = yearArray(i)
if not fso.FolderExists(ArchiveP & yearStamp) then
fso.createFolder(ArchiveP & yearStamp)
end if
ArchiveP = ArchiveP & yearStamp & "\"
for each dateFold in subFold
Set fo = fso.GetFolder(InputP & dateFold.Name)
folderName = InputP & dateFold.name & "\"
foldName = fo.name & "\"
if left(foldName,4) = yearStamp then
fso.MoveFolder folderName , ArchiveP & foldName
end if
next
ArchiveP = UnChangeP & PreArchP
Next
The error happens at fso.MoveFolder folderName , ArchiveP & foldName and I can't figure out what is happening.
The error you're getting is caused by misconstructed paths. What you're trying to do is something like this:
fso.MoveFolder "C:\input\2013_03", "D:\archive\2013\2013_03"
However, what you're acutally doing is this:
fso.MoveFolder "C:\input\2013_03\", "D:\archive\2013\2013_03\"
^ ^
A trailing backslash is only valid in the destination path, and only if the destination path is the parent folder to which you want to move the source folder, i.e. your statement should look either like this:
fso.MoveFolder "C:\input\2013_03", "D:\archive\2013\"
or like this:
fso.MoveFolder "C:\input\2013_03", "D:\archive\2013\2013_03"
Avoid building paths via string concatenation. The FileSystemObjects provides a method BuildPath that will handle path separators correctly.
Your code is rather convoluted, BTW. Instead of using indexed access to yearArray you could simply iterate over all elements with a For Each loop. Also, your iteration over the subfolders of InputP already provides you with Folder objects. fso.GetFolder(InputP & dateFold.Name) is the exact same object as dateFold. Plus, Folder objects come with a Move method, so you'd only need to handle the destination path.
I believe your code could be simplified to the following, which should do what you want:
For Each year In yearArray
dst = fso.BuildPath(ArchiveP, year)
If Not fso.FolderExists(dst) Then fso.CreateFolder dst
For Each dateFold In fso.GetFolder(InputP).SubFolders
If Left(dateFold.Name, 4) = year Then dateFold.Move dst & "\"
Next
Next
In terms of performance it might be a good idea to switch the two loops, though. Iterating over folders means you have to read from disk whereas yearArray is in memory, thus the former iteration is bound to be slower than the latter. By making the subfolder iteration the outer loop (and putting the destination folder creation in a separate loop) you eliminate this bottleneck, because that way you read each subfolder just once.
For Each year In yearArray
dst = fso.BuildPath(ArchiveP, year)
If Not fso.FolderExists(dst) Then fso.CreateFolder dst
Next
For Each dateFold In fso.GetFolder(InputP).SubFolders
For Each year In yearArray
dst = fso.BuildPath(ArchiveP, year)
If Left(dateFold.Name, 4) = year Then dateFold.Move dst & "\"
Next
Next

VBScript to find and move files automatically

I've been tasked with trying to automate a task at work, because we've had issues lately with people remembering to do it.
In general, here's what I need a script to do:
Get the date of the previous day, in the format YYYYMMDD
Enter a folder with that given name
Search within all the folders underneath that location for 4 specific files
Copy those files to several different locations
The issue I'm having is that, for the 4 files I'm looking for, they're located in 2 different folders. 3 in 1, 1 in the other. The names of these folders changes daily, depending on what queue they got put into when generated by some other software. I need these files to be moved so that another script can be run on them. I'm having trouble figuring out how to accomplish this. Anyone have some ideas?
If the folders containing the interesting files are subfolders of your dated directory, you can use a nested loop:
Dim sDFolder : sDFolder = "..\data\20110105"
Dim dicFiNa : Set dicFiNa = CreateObject("Scripting.Dictionary")
dicFiNa("1.txt") = ""
dicFiNa("3.txt") = ""
dicFiNa("5.txt") = ""
Dim oRDir : Set oRDir = goFS.GetFolder(sDFolder)
Dim oSDir
For Each oSDir In oRDir.SubFolders
Dim oFile
For Each oFile In oSDir.Files
WScript.Echo "looking at", oFile.Path
If dicFiNa.Exists(oFile.Name) Then
WScript.Echo "found", oFile.Name, "will copy"
End If
Next
Next
output:
looking at E:\trials\SoTrials\answers\8750206\data\20110105\whatever\6.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\whatever\5.txt
found 5.txt will copy
looking at E:\trials\SoTrials\answers\8750206\data\20110105\unknown\4.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\unknown\3.txt
found 3.txt will copy
looking at E:\trials\SoTrials\answers\8750206\data\20110105\puzzle\2.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\puzzle\1.txt
found 1.txt will copy
A full recursive walk would be a bit more complex, so say so, if you need it.
Just for fun: a recursive version:
Dim sDFolder : sDFolder = "..\data\20110105"
Dim dicFiNa : Set dicFiNa = CreateObject("Scripting.Dictionary")
dicFiNa("1.txt") = ""
dicFiNa("3.txt") = ""
dicFiNa("55.txt") = ""
Dim oRDir : Set oRDir = goFS.GetFolder(sDFolder)
walk oRDir, dicFiNa, "whatever you need to copy the files"
Sub walk(oDir, dicFiNa, vCargo)
Dim oItem
For Each oItem In oDir.Files
WScript.Echo "looking at", oItem.Path
If dicFiNa.Exists(oItem.Name) Then
WScript.Echo "found", oItem.Name, "will copy"
End If
Next
For Each oItem In oDir.SubFolders
walk oItem, dicFiNa, vCargo
Next
End Sub
output:
looking at E:\trials\SoTrials\answers\8750206\data\20110105\whatever\6.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\whatever\5.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\unknown\4.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\unknown\3.txt
found 3.txt will copy *
looking at E:\trials\SoTrials\answers\8750206\data\20110105\puzzle\2.txt
looking at E:\trials\SoTrials\answers\8750206\data\20110105\puzzle\1.txt
found 1.txt will copy *
looking at E:\trials\SoTrials\answers\8750206\data\20110105\puzzle\deep\deeper\55.txt
found 55.txt will copy *
(*) as soon as the permission problem is solved.

I have two text files, I need to merge the two with a date stamp using VBscript

I have two .txt files; I have written a VBscript to identify the two last modified files. The code echoes the two modified files separately. I need to merge these two modified files and provide a different name with a date stamp.
Example:
txt1.txt
txt2.txt
After merge:
txt09022011.txt
Assuming you just want to dump the contents of each text file in sequence into a new text file:
Dim strInputPath1, strInputPath2, strOutputPath
Dim txsInput1, txsInput2, txsOutput
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
strInputPath1 = "C:\txt1.txt"
strInputPath2 = "C:\txt2.txt"
strOutputPath = "C:\txt" & Format(Now, "ddmmyyyy") & ".txt"
' For the timestamp I use Now (today's date). Can also choose some other date.
Set txsInput1 = FSO.OpenTextFile(strInputPath1, 1)
Set txsInput2 = FSO.OpenTextFile(strInputPath2, 1)
Set txsOutput = FSO.CreateTextFile(strOutputPath)
txsOutput.Write txsInput1.ReadAll
txsOutput.Write txsInput2.ReadAll
txsInput1.Close
txsInput2.Close
txsOutput.Close

VBScript to export all members of multiple Active Directory groups?

Is there a way of exporting all the members of multiple Active Directory groups at once using a VBScript? Preferably the output would be the usernames listed under the group they are a member of.
I have the following which allows me to export the members of 1 AD Group at a time, but I am at a loss as to how to modify it to look at multiple groups.
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set outfile = fso.CreateTextFile("Members.csv")
Set objGroup = GetObject("LDAP://cn=*GROUPNAME*,OU=Groups,DC=domain,DC=local")
objGroup.GetInfo
arrMembersOf = objGroup.GetEx("member")
For Each GetObject in ObjGroup
outfile.WriteLine objGroup.Name
Next
For Each strMember in arrMembersOf
outfile.WriteLine strMember
Next
Any ideas?
Yeah, this is possible, but I think you might need to change your approach slightly. You need to write an LDAP query to query two groups at once, rather than just setting your scope to a particular group.
So, try reworking your script like this:
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set objRootDSE = Nothing
Set ad = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
ad.ActiveConnection = adoConnection
'Put the distinguishedname of your two groups here:
strFilter = "(|(memberof=CN=Group Name,OU=....)(memberof=CN=Group Name 2,OU=....))"
'Chose what you want to return here:
strAttributes = "samaccountname,cn"
strQuery = "<LDAP://" & strDNSDomain & ">" & ";" & strFilter & ";" & strAttributes & ";subtree"
ad.CommandText = strQuery
ad.Properties("SearchScope") = 2
ad.Properties("Page Size") = 1000
ad.Properties("Cache Results") = False
Set objRS = ad.Execute
Now you've got all the results in a recordset, you can work your way through them writing each one to a file or whatever you want to do. So something like:
Do Until objRS.EOF
'Do something with each value
objRS.Fields("samaccountname")
objRS.MoveNext
Loop
Any use? I'm assuming here you know a little bit about writing LDAP queries
The best place to find scripts for Active Directory is Microsoft's Script Center Repository.
You can find a script listing all groups and all group members here ("List all groups in the domain and all members of the groups").

Resources