McKirahan
Sat Feb 02 14:50:11 CST 2008
<desmond.mcalister@googlemail.com> wrote in message
news:a15b89c7-4def-47f6-840e-99d5e87701d6@d21g2000prf.googlegroups.com...
On Feb 2, 11:13 am, "McKirahan" <N...@McKirahan.com> wrote:
> Please respond in the ng so others may benefit.
>
> Apologies. I thought you meant for me to reply to author.
>
> HTA and Control file would be fine. Have you got a script in mind?
When responding within a newsgroup (ng) you should always use
"Reply Group" and append your response to the bottom of the thread
as this allows other to follow the "conversation" chronologically.
This post contains the contents of three files. Watch for word-wrap.
Study them and test them then let me know if you have any questions.
The HTA's interface is pretty basic. There is sufficient error checking.
1) "ZANTAZ.hta" is used to create new subfolders under:
F:\ZANTAZ\Retail Repositories\ -or-
F:\ZANTAZ\Wholesale Repositories\
Note that the control file is backed up each time.
If "RE00205" is created then before the control file
is updated it is copied to "ZANTAZ.txt.RE00205".
(Periodically, you should delete this backup files.)
2) "ZANTAZ.txt" is the initial control file.
It is only used if no subfolders exist under:
F:\ZANTAZ\Retail Repositories\ -and-
F:\ZANTAZ\Wholesale Repositories\
Note that the control file will work with just 4 lines:
just change the "RE00000" and "WS00000" to the
highest numbered subfolders that already exist.
3) "ZANTAZ.vbs" is used to create/recreate the control file.
It is used if subfolders exist under:
F:\ZANTAZ\Retail Repositories\ -and-
F:\ZANTAZ\Wholesale Repositories\
("ZANTAZ.txt" will be renamed "ZANTAZ.sav".)
Note that this using this script is totally optional.
(However, it will identify all existing subfolders.)
All files should be placed under the folder "F:\ZANTAZ\".
Both scripts identify this folder as the value of "cFOL";
(the value of "cFOL" can be changed for testing purposes).
If you want the files elsewhere then the "Preprocess" code
needs to be modified; (i.e. comparing "cFOL" with "sDIR").
"ZANTAZ.hta" ..................................................
<html>
<head>
<title>ZANTZ.hta</title>
<HTA:Application
ID = "HTA"
ApplicationName = "ZANTZ"
Border = "thin"
BorderStyle = "normal"
Caption = "yes"
ContextMenu="yes"
Icon = "Northwind.ico"
InnerBorder="no"
MaximizeButton = "yes"
MinimizeButton = "yes"
Navigable="yes"
Scroll="yes"
SrollFlat="no"
Selection="yes"
ShowInTaskBar = "yes"
SingleInstance = "yes"
SysMenu = "yes"
Version = "1.0"
WindowState = "maximize"
>
<script type="text/vbscript">
Option Explicit
'****
'* ------------------------------------------------------------------------
----
'* This HTA (HTML Application) does the following:
'* 1) Read the control file ("cTXT") to identify the root folders under
"cFOL"
'* as well as to determine the next new folder name under each root
folder.
'* Display the root folder choices to the user as buttons for
selection.
'* Display of the control file is also an option.
'* 2) Create the new folder & subfolders (per "cSUB") under the selected
root
'* folder. Update the control file with an entry for the new folder.
'* (Note that the control file is copied before it is updated -- in
case.)
'* Display the new subfolder structure created along with a "Close"
button.
'*
'* The basic control file contains 2 lines per root folder (which are in
[]'s):
'* [Retail Repositories]
'* RE00000,yyyy-mm-dd,who
'* [Wholesale Repositories]
'* WS00000,yyyy-mm-dd,who
'* ....+....1....+....2....+ (this line indicates the control file
columns)
'* ------------------------------------------------------------------------
----
'****
'*
'* Declare Constants
'*
Const cHTA = "ZANTAZ.hta" '= Script name
Const cTXT = "ZANTAZ.txt" '= Control file
Const cFOL = "F:\ZANTAZ\" '= Base folder
Const cSUB = "_Images,_Text,_Versions" '= Subfolders list
Const cCTL = "<button class='butt' onclick='Control_File()'>Control
File</button>"
Const cHTM = "<br><br><button class='butt'
onclick=`window.close()`>Close</button>"
Const cWMI = "winmgmts:{impersonationLevel=impersonate}!//."
'*
'* Declare Globals
'*
Dim sCTL
sCTL = "<b>Control file:</b> " & cFOL & cTXT &
"<br><br><pre>?</pre>"
Dim sDIR
sDIR = CreateObject("WScript.Shell").CurrentDirectory & "\"
Dim aFOL()
Dim iFOL
iFOL = 0
Dim sFOL
Dim sHTM
Dim dNOW
dNOW = Now
Dim aSUB()
Dim aTXT()
Dim iTXT
iTXT = 0
Dim sTXT
Dim sWHO
sWHO = ""
Dim sYMD
sYMD = DatePart("yyyy",dNOW) _
& "-" & Right(100+DatePart("m",dNOW),2) _
& "-" & Right(100+DatePart("d",dNOW),2)
Sub Window_Onload()
'****
'* Examine "cFOL"
'****
sHTM = cCTL & "<br><br><b>Create subfolders under (click one):</b>"
'*
'* Declare Variables
'*
Dim strBUT
Dim intDIC
Dim strDIC
Dim booERR
booERR = False
Dim booFOL
booFOL = False
Dim strFOL
Dim strSFN '= SubFolder Name (e.g. "RE00001")
Dim strSFP '= SubFolder Prefix (e.g. "RE")
Dim strSFS '= SubFolder Suffix (e.g. "00001")
Dim intSFX '= SubFolder Suffix (e.g. 00002)
Dim arrSUB '= SUBfolder extensions
arrSUB = Split(cSUB,",")
Dim intSUB
Dim strSUB
Dim arrTXT
Dim intTXT
Dim strTXT
Dim arrVAL
Dim intVAL
Dim strVAL
DIm strWHO
'*
'* Declare Objects
'*
Dim objDIC
Dim objFSO
Dim objTXT
'*
'* Assign Objects
'*
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDIC = CreateObject("Scripting.Dictionary")
Dim objWMI
Set objWMI = GetObject(cWMI).InstancesOf("Win32_ComputerSystem")
For Each strWHO in objWMI
sWHO = strWHO.UserName & ""
Exit For
Next
'*
'* Preprocess
'*
If LCase(cFOL) <> LCase(sDIR) Then
'*
'* Test this folder
'*
booERR = True
MsgBox cFOL & " <> " & sDIR,vbCritical,cVBS
ElseIf Not objFSO.FolderExists(cFOL) Then
'*
'* Test base folder
'*
booERR = True
MsgBox cFOL & " does not exist!",vbCritical,cHTA
ElseIf Not objFSO.FileExists(cFOL & cTXT) Then
'*
'* Test control file
'*
booERR = True
MsgBox cFOL & cTXT & " does not exist!",vbCritical,cHTA
End If
'*
'* Process
'*
If Not booERR Then
'*
'* Read control file
'*
Set objTXT = objFSO.OpenTextFile(cFOL & cTXT,1)
strTXT = objTXT.ReadAll
Set objTXT = Nothing
'*
'* Test control file
'*
sCTL = Replace(sCTL,"?",strTXT)
arrTXT = Split(strTXT,vbCrLf)
For intTXT = 0 To UBound(arrTXT)
strTXT = arrTXT(intTXT)
If strTXT = "" Then Exit For
If Left(strTXT,1) = "[" _
And Right(strTXT,1) = "]" Then
'*
'* Folders
'*
booFOL = True
strFOL = Mid(strTXT,2,Len(strTXT)-2)
If Not objFSO.FolderExists(cFOL & strFOL) Then
booERR = True
MsgBox cFOL & strFOL & " does not
exist!",vbCritical,cHTA
Exit For
End If
iTXT = iTXT + 1
ReDim Preserve aTXT(iTXT)
aTXT(iTXT) = strTXT & vbCrLf
objDIC.Add strFOL, iTXT
objDIC.Add iTXT, ""
strBUT = "Create_Folders(" & iTXT & ")"
strBUT = "<button class='butt' onclick='" & strBUT &
"'>?</button>"
sHTM = sHTM & "<br><br>" & Replace(strBUT,"?",strFOL)
Else
'*
'* Entries
'*
If booFOL And Left(strTXT,1) = " " Then
aTXT(iTXT) = aTXT(iTXT) & strTXT & vbCrLf
arrVAL = Split(Trim(strTXT),",")
If UBound(arrVAL) = 2 _
And Len(arrVAL(0)) = 7 _
And Not IsNumeric(Left(arrVAL(0),2)) _
And IsNumeric(Right(arrVAL(0),5)) Then
objDIC.Item(iTXT) = arrVAL(0)
If Right(arrVAL(0),5) <> "00000" Then
strSUB = cFOL & strFOL & "\" & arrVAL(0)
If Not objFSO.FolderExists(strSUB) Then
booERR = True
MsgBox strSUB & " does not
exist!",vbCritical,cHTA
Exit For
End If
End If
Else
booERR = True
MsgBox strTXT & "!!",vbCritical,cHTA
Exit For
End If
Else
booERR = True
MsgBox strTXT & "!!!",vbCritical,cHTA
Exit For
End If
End If
Next
End If
'*
'* New folders
'*
If Not booERR Then
ReDim aFOL(iTXT,UBound(arrSUB)+1)
ReDim aSUB(iTXT)
For Each strDIC In objDIC
If Not IsNumeric(strDIC) Then
iFOL = objDIC.Item(strDIC)
strSFN = objDIC.Item(iFOL)
strSFP = Left(strSFN,2)
strSFS = Right(strSFN,5)
intSFX = Right(100001+CInt(strSFS),5)
strSFN = strSFP & intSFX
aFOL(iFOL,0) = cFOL & strDIC & "\" & strSFN
aSUB(iFOL) = strSFN
For intSUB = 0 To UBound(arrSUB)
strSUB = arrSUB(intSUB)
aFOL(iFOL,intSUB+1) = aFOL(iFOL,0) & "\" & strSFN &
strSUB
Next
End If
Next
End If
'*
'* Destroy Objects
'*
Set objDIC = Nothing
Set objFSO = Nothing
Set objWMI = Nothing
'*
'* Finish
'*
If booERR Then sHTM = "<b>Error!</b>"
document.getElementById("Output").innerHTML = sHTM
End Sub
Sub Control_File()
'****
'* Display the control file
'****
document.getElementById("Output").innerHTML = sCTL & cHTM
End Sub
Sub Create_Folders(iFOL)
'****
'* Generate new folder and its subfolders
'****
document.getElementById("Output").innerHTML = "<b>Processing...</b>"
sHTM = "<b>The following folders were created:</b><br>"
'*
'* Declare Variables
'*
Dim strCTF
Dim booERR
booERR = False
Dim strFIL
Dim intFOR
'*
'* Declare Objects
'*
Dim objCTF
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'*
'* Test folder
'*
sFOL = aFOL(iFOL,0)
If objFSO.FolderExists(sFOL) Then
booERR = True
MsgBox sFOL & " already exists!",vbCritical,cHTA
Else
'*
'* Create folder and subfolders
'*
For intFOR = 0 To UBound(aFOL,2)
sFOL = aFOL(iFOL,intFOR)
objFSO.CreateFolder sFOL
sHTM = sHTM & "<br>" & sFOL
Next
'*
'* Backup control file
'*
strFIL = cFOL & cTXT & "." & aSUB(iFOL)
If objFSO.FileExists(strFIL) Then
objFSO.DeleteFile(strFIL)
End If
objFSO.CopyFile cFOL & cTXT, strFIL
'*
'* Replace control file
'*
sTXT = " " & aSUB(iFOL) & "," & sYMD & "," & sWHO & vbCrLf
aTXT(iFOL) = aTXT(iFOL) & sTXT
strCTF = Join(aTXT,"")
Set objCTF = objFSO.CreateTextFile(cFOL & cTXT,True)
objCTF.Write strCTF
Set objCTF = Nothing
End If
'*
'* Destroy Objects
'*
Set objFSO = Nothing
'*
'* Finish
'*
If booERR Then sHTM = "<b>Error!</b>"
document.getElementById("Output").innerHTML = sHTM & cHTM
End Sub
</script>
<style type="text/css">
body { font-family:Arial; font-size:9pt }
td { font-family:Arial; font-size:8pt }
th { font-family:Arial; font-size:8pt; font-weight:bold }
.butt { background-color:white; font-weight:bold; width:300px }
.line { border:solid 1px black }
</style>
</head>
<body>
<h5>ZANTAZ Subfolders</h5>
<span id="Output"></span>
</body>
</html>
"ZANTAZ.txt" ..................................................
[Retail Repositories]
RE00000,yyyy-mm-dd,who
[Wholesale Repositories]
WS00000,yyyy-mm-dd,who
"ZANTAZ.vbs" ..................................................
Option Explicit
'****
'* ------------------------------------------------------------------------
----
'* 1) Create a control file "cTXT" that identifies folders under "cFOL".
'*
'* The control file contains 2+ lines per root folder (which are in []'s):
'* [Retail Repositories]
'* RE00000,yyyy-mm-dd,who
'* [Wholesale Repositories]
'* WS00000,yyyy-mm-dd,who
'* ....+....1....+....2....+ (this line indicates the control file
columns)
'* ------------------------------------------------------------------------
----
'****
'*
'* Declare Constants
'*
Const cVBS = "ZANTAZ.vbs"
Const cTXT = "ZANTAZ.txt"
Const cFOL = "F:\ZANTAZ\"
Const cSAV = ".sav"
Const cSUB = "_Images,_Text,_Versions"
'*
'* Declare Globals
'*
Dim sDIR
sDIR = WScript.ScriptFullName
sDIR = Left(sDIR,InStrRev(sDIR,"\"))
'*
'* Declare Variables
'*
Dim i, j, k
Dim strCTF
strCTF = ""
Dim strDIC
Dim strDLM
Dim booERR
booERR = False
Dim strFIL
Dim arrFOL()
ReDim arrFOL(0)
arrFOL(0) = cFOL
Dim booFOL
booFOL = False
Dim intFOL
intFOL = 0
Dim strFOL
Dim strPRE
Dim strSFN
Dim arrSUB
arrSUB = Split(cSUB,",")
Dim booSUB
Dim intSUB
Dim strSUB
Dim strYMD
'*
'* Declare Objects
'*
Dim objCTF
Dim objDIC
Dim objFSO
Dim objGFO
Dim objTXT
'*
'* Assign Objects
'*
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDIC = CreateObject("Scripting.Dictionary")
'*
'* Preprocess
'*
If LCase(cFOL) <> LCase(sDIR) Then
'*
'* Test this folder
'*
booERR = True
MsgBox cFOL & " <> " & sDIR,vbCritical,cVBS
ElseIf Not objFSO.FolderExists(cFOL) Then
'*
'* Test base folder
'*
booERR = True
MsgBox cFOL & " does not exist!",vbCritical,cVBS
ElseIf objFSO.FileExists(cFOL & cTXT) Then
'*
'* Test control file
'*
booERR = True
MsgBox cFOL & cTXT & " already exists!",vbCritical,cVBS
End If
'*
'* Process
'*
If Not booERR Then
Call Folders(cFOL)
'*
'* Sort folders
'*
For i = UBound(arrFOL) - 1 To 0 Step -1
For j = 0 To i
If arrFOL(j) > arrFOL(j+1) Then
k = arrFOL(j+1)
arrFOL(j+1) = arrFOL(j)
arrFOL(j) = k
End If
Next
Next
'*
'* List folders
'*
For intFOL = 1 To UBound(arrFOL)
strFOL = arrFOL(intFOL)
strFOL = Mid(strFOL,Len(cFOL)+1)
If strCTF <> "" Then strCTF = strCTF & vbCrLf
If InStr(strFOL,"\") = 0 Then
strPRE = strFOL
strCTF = strCTF & "[" & strFOL & "]"
Else
strDIC = Mid(strFOL,Len(strPRE)+2)
strCTF = strCTF & " " & strDIC & "," & objDIC.Item(strDIC) &
","
End If
Next
'*
'* Backup control file
'*
If objFSO.FileExists(sDIR & cTXT) Then
strFIL = sDIR & cTXT & cSAV
If objFSO.FileExists(strFIL) Then
objFSO.DeleteFile(strFIL)
End If
objFSO.CopyFile sDIR & cTXT, strFIL
End If
'*
'* Replace control file
'*
Set objCTF = objFSO.CreateTextFile(sDIR & cTXT,True)
objCTF.Write strCTF
Set objCTF = Nothing
End If
'*
'* Destroy Objects
'*
Set objDIC = Nothing
Set objFSO = Nothing
'*
'* Finish Message
'*
MsgBox "Done!",vbInformation,cVBS
Sub Folders(folder)
'****
'* Identify all Folders
'****
For Each strFOL In objFSO.GetFolder(folder).SubFolders
If folder = cFOL Then objDIC.Add strFOL.Path, intFOL
'*
'* Skip subfolders in "cSUB"
'*
booSUB = False
For intSUB = 0 To UBound(arrSUB)
strSUB = arrSUB(intSUB)
If InStr(strFOL.Path,strSUB) > 0 Then booSUB = True
Next
'*
'* Save subfolders
'*
If Not booSUB Then
'*
'* DateLastModified
'*
If folder <> cFOL Then
Set objGFO = objFSO.GetFolder(strFOL.Path)
strDLM = objGFO.DateLastModified
Set objGFO = Nothing
strYMD = DatePart("yyyy",strDLM) _
& "-" & Right(100+DatePart("m",strDLM),2) _
& "-" & Right(100+DatePart("d",strDLM),2)
strSFN = Mid(strFOL.Path,Len(folder)+2)
objDIC.Add strSFN, strYMD
End If
'*
intFOL = intFOL + 1
ReDim Preserve arrFOL(intFOL)
arrFOL(intFOL) = strFOL.Path
Call Folders(strFOL.Path)
End If
Next
End Sub