FolderLister

Sub ShowSubFolders (Folder, Depth)  
column = 1
If Depth > 0 then        
For Each Subfolder in Folder.SubFolders            
ShowSubFolders Subfolder, Depth - 1        

ObjXL.ActiveSheet.Cells(icount,column).Value = Subfolder.Path
ObjXL.ActiveSheet.Cells(icount,column).select
CAFLink = Subfolder.Path
ObjXL.Workbooks(1).Worksheets(1).Hyperlinks.Add ObjXL.Selection, CAFLink
icount = icount + 1

Next    

End if
End Sub
' Specify Folder Depth (D)
D = 2
' Get CAF Path from user (rootfolder)
rootfolder = Inputbox("Enter CAF or folder path: " & chr(10) & "(e.g.\\Server\Root Folder Name\Folder\etc\)" & chr(10) & _
 chr(10) & "Folder Depth Currently Set to " & D & " folder levels " & chr(10), _
"Directory Tree Generator", "C:\Temp\")
'Run ShowSubFolders if something was entered in the CAF directory field, else just end
if rootfolder <> "" Then

outputfile = "C:\Temp\" & Year(now) & Month(now) & Day(now) & "DIR_MAP_V1.0.xlsx"
Set fso = CreateObject("scripting.filesystemobject")
if fso.fileexists(outputfile) then fso.deletefile(outputfile)

'Create Excel workbook
set objXL = CreateObject( "Excel.Application" )
objXL.Visible = False
objXL.WorkBooks.Add
'Counter 1 for writing in cell A1 within the excel workbook
icount = 1
'Run ShowSubfolders - D is the folder depth to parse
ShowSubfolders FSO.GetFolder(rootfolder), D  

'Lay out for Excel workbook
  objXL.Range("A1").Select
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert

  objXL.Columns(1).ColumnWidth = 90
  objXL.Range("A1").NumberFormat = "d-m-yyyy"
  objXL.Range("A1:A3").Select
  objXL.Selection.Font.Bold = True
  objXL.Range("A1:B3").Select
  objXL.Selection.Font.ColorIndex = 5
  objXL.Range("A2").Select
  ObjXL.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
  ObjXL.ActiveSheet.Cells(2,1).Value = "DIRECTORY MAP FOLDER DEPTH:- " & D  
  ObjXL.ActiveSheet.Cells(3,1).Value = UCase(rootfolder)
  objXL.Range("A1").Select
  objXL.Selection.Font.Bold = True
'Finally close the workbook
  ObjXL.ActiveWorkbook.SaveAs(outputfile)
  ObjXL.Application.Quit
  Set ObjXL = Nothing
'Message when finished
  Set WshShell = CreateObject("WScript.Shell")
  Finished = Msgbox ("CAF Map Generated Here:-" & Chr(10) _
& outputfile & "." & Chr(10) _
& "Do you want to open the Folder Map now?", 65, "DIRECTORY Map Generator")
  if Finished = 1 then WshShell.Run "excel " & outputfile

end if

AllUsersTemplates

Templates Update

Option Explicit
'------------------------------------------------------------------------------------------------
' VBScript to deploy changes & deletions of document Templates
'
' NOTE: This script copies the files to/deletes files from each users' Templates folder, e.g
'       C:\Documents and Settings\<user>\Application Data\Microsoft\Templates
'------------------------------------------------------------------------------------------------

Dim IniFile
IniFile = "BTTemplate.INI"

'------------------------------------------------------------------------
' Preparations - create objects, define variables, get values, etc.
'------------------------------------------------------------------------

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const ScriptName = "BTTemplatesUpdate.vbs"
Const INIFileName = "INIs\SiteRef.INI"
Const RemoveTemplatesFileName = "INIs\RemoveTemplates.txt"
Const AllUsersTemplatesFolder = "C:\Documents and Settings\Default User\Application Data\Microsoft\Templates"
Const UserTemplatesPath = "\Application Data\Microsoft\Templates"

' Objects
Dim WshShell
Dim ObjEnv
Dim Fso
Dim Wshnetwork

' Variables
Dim NewTemplatesFolder
Dim UserTemplatesFolder
Dim RemoveTemplates()
ReDim RemoveTemplates(0)
Dim RmvTmplCount
Dim log
Dim LogFile
Dim CurrWorkDir

' INI File values
Dim TemplatePath
Dim TemplateFileSite

Set WshShell=wscript.createobject("wscript.shell")
Set ObjEnv= wshshell.environment("Process")
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Set Wshnetwork=wscript.createobject("wscript.network")

On Error Resume Next

' Keep log in standard logs location
log = "C:\Windows\Appslogs\TemplatesUpdate.log"

'------------------------------------------------------------------------------------------------
' Ready...
'------------------------------------------------------------------------------------------------

' Set the location of the new Templates
CurrWorkDir = WshShell.CurrentDirectory & "\"


' Check for and, if necessary create the All Users Templates folder
If Not Fso.FolderExists(AllUsersTemplatesFolder) Then
Fso.CreateFolder(AllUsersTemplatesFolder)
End If

' Create or Open logfile and add entry
Set LogFile = Fso.OpenTextFile(log, ForAppending, True)
call Writelog("* * * Start Script * * *")

' Clear errors in case key doesn't exist
Err.Clear

' Check required files exist
CheckFiles

' Read SiteRef.INI and Delete Templates.txt files
ReadINIFiles
If Len(Trim(TemplatePath)) = 0 Then
' Report error and stop
ExitScript("104 No valid value for TemplatePath")

End If

If Len(Trim(TemplateFileSite)) = 0 Then
' Report error and stop
ExitScript("105 No valid value for TemplateFileSite")

End If


' Check referenced new templates folder exists
CheckTemplatesFolder

' Check correct PC for supplied templates
CheckPCTemplates

' Update the Templates held in All Users AND by each user
WriteLog("All checks passed... updating PC")
UpdateTemplates


' End
ExitScript("0 Script completed OK")

'------------------------------------------------------------------------------------------------
' Subroutines
'------------------------------------------------------------------------------------------------
' Check required files exist
Sub CheckFiles()

' Check INI and DeleteTemplates files exist...
'
' SiteRef.INI
If Not Fso.FileExists(CurrWorkDir & INIFileName) Then
  ' Report error and stop
  ExitScript("100 INI File (" & CurrWorkDir & INIFileName & ") not found")
End If

' DeleteTemplates
If Not Fso.FileExists(CurrWorkDir & RemoveTemplatesFileName) Then
  ' Report error and stop
  ExitScript("101 Delete Templates File (" & CurrWorkDir & RemoveTemplatesFileName & ") not found")
End If

End Sub
'------------------------------------------------------------------------------------------------
' Read the INI file
Sub ReadINIFiles()
Dim f1
Dim ReadLine

' Read the INI file. Store the TemplatePath and TemplateFileSite values, and build an
' array of the Templates to delete

  Set f1 = fso.OpenTextFile(CurrWorkDir & INIFileName, ForReading)
 
' Read all lines in the file
Do Until f1.AtEndOfStream
  ReadLine = Trim(f1.ReadLine)
 
  ' Ignore commented out and blank lines
  If Left(ReadLine,1) <> ";" And Len(ReadLine) > 0 Then
  ' If INI file there will be value labels - extract their values
  If Ucase(Left(ReadLine, 13)) = "TEMPLATEPATH=" Then
  TemplatePath = Mid(ReadLine,14)
WriteLog("TemplatePath = " & TemplatePath)  
 
  ElseIf Ucase(Left(ReadLine, 17)) = "TEMPLATEFILESITE=" Then
  TemplateFileSite = Mid(ReadLine,18)
WriteLog("TemplateFileSite = " & TemplateFileSite)  
 
  End If
End If
Loop

f1.Close
  Set f1 = Nothing


' Read the RemoveTemplates file and store in the RemoveTemplates() array

  Set f1 = fso.OpenTextFile(CurrWorkDir & RemoveTemplatesFileName, ForReading)
  RmvTmplCount = 0
 
' Read all lines in the file
Do Until f1.AtEndOfStream
  ReadLine = Trim(f1.ReadLine)
 
  ' Ignore commented out and blank lines
  If Left(ReadLine,1) <> ";" And Len(ReadLine) > 0 Then
 
RemoveTemplates(RmvTmplCount) = ReadLine

' Increment array count & redefine the array
RmvTmplCount = RmvTmplCount + 1
ReDim Preserve RemoveTemplates(RmvTmplCount)

End If
Loop

f1.Close
  Set f1 = Nothing

End Sub
'------------------------------------------------------------------------------------------------
' Check the Templates folder exists
Sub CheckTemplatesFolder()

If Not Fso.FolderExists(CurrWorkDir & "Templates") Then
  ' Templates folder not found - exit
  WriteLog("Error 102 Templates Folder (" & CurrWorkDir & "Templates" & "\" & TemplatePath & ") not found")
  ExitScript("102 Templates Folder not found")
  End If

End Sub
'------------------------------------------------------------------------------------------------
' Check PC has the previous version of the example Template
Sub CheckPCTemplates()

' Only need to check this is a suitable target PC if the TemplateFileSite value is not "no_check"
If Lcase(TemplateFileSite) <> "no_check" Then
' Check the named fie exists on the PC
If Not Fso.FileExists(AllUsersTemplatesFolder & "\" & TemplateFileSite) Then
' File not found - this is not a suitable PC
WriteLog("Error 103 TemplateFileSite (" & AllUsersTemplatesFolder & "\" & TemplateFileSite & ") not found")
ExitScript("103 TemplateFileSite file not found")
End If
End If

End Sub
'------------------------------------------------------------------------------------------------
' Update the Templates on the PC
Sub UpdateTemplates()
Dim f
Dim sf
Dim folderName
Dim x

' Ignore any error
On error Resume Next

NewTemplatesFolder = CurrWorkDir & "Templates" & "\" & TemplatePath

' Process every user folder (this includes Default User)
Set f = Fso.GetFolder("C:\Documents and Settings")
Set sf = f.SubFolders

' Copy to each user's Templates folder
For Each folderName In sf
WriteLog("Processing " & folderName)

' Set the Templates path
UserTemplatesFolder = folderName  & UserTemplatesPath

' If Users Templates folder does not exist, create one
If Not Fso.FolderExists(UserTemplatesFolder) Then
WriteLog(UserTemplatesFolder & " not found... creating")
Fso.CreateFolder(UserTemplatesFolder)
End If

' Copy new templates
FSO.DeleteFile(UserTemplatesFolder & "\*.*")
Fso.CopyFile NewTemplatesFolder & "\*.*", UserTemplatesFolder, True
If Err.Number <> 0 then
If Err.Number <> 76 Then ' Ignore "Path not found" - usually applies to All Users folder
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error copying files")
End If
Err.Clear
End If

' Check for and if present delete files listed in the RemoveTemplate() array
For x = 0 to (RmvTmplCount - 1)
  If Fso.FileExists(UserTemplatesFolder & RemoveTemplates(x)) Then
  ' Delete the file
  WriteLog("Deleting file " & UserTemplatesFolder & RemoveTemplates(x))
  Fso.DeleteFile UserTemplatesFolder & RemoveTemplates(x), True
If Err.Number <> 0 then
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error deleting file")
Err.Clear
End If
  End If
Next

' Reset user flag to force Templates location reset next time user logs on
WriteLog("Deleting user flag (" & UserTemplatesFolder & "\*Otmp.FLG" & ") to force Template folder location reset")
Fso.DeleteFile UserTemplatesFolder & "\*Otmp.FLG", True
If Err.Number <> 0 Then
' Ignore "File Not Found"
If Err.Number <> 53 Then
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error deleting file")
End If
Err.Clear
End If

Next ' Loop to next User folder

End Sub
'------------------------------------------------------------------------------------------------
' Exit and report why
Function ExitScript(ExitText)
Dim ErrorCode

' Extract the error code from the start of the supplied text. This may not be 3 digits, so
' manipulate it
If IsNumeric(Left(ExitText,3)) Then
ErrorCode = Left(ExitText,3)
ElseIf IsNumeric("0" & Left(ExitText,2)) Then
ErrorCode = "0" & Left(ExitText,2)
Else
ErrorCode = "00" & Left(ExitText,1)
End If

' Log messages other than 999 codes
If ErrorCode <> "999" then
call Writelog("Script exiting with error: " & ExitText)
call Writelog("* * * End Script * * *")
LogFile.WriteLine
End If

' Exit the script & return the error code
Wscript.Quit ErrorCode
End Function

'------------------------------------------------------------------------------------------------
' Write entry to log
Function WriteLog(LogText)
LogFile.WriteLine Date() & " " & Time() & " " & ScriptName & ": " &  LogText
End Function

SIDFetch

PsGetsid.exe ANSI to TEXT Conversion Scripts
.....................................................................................................................................................................................................................................................................................................................................

SID Conversion

on error resume next
Const ForReading = 1
Const TristateTrue = -1 'UniCode
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Windir = WshShell.ExpandEnvironmentStrings("%windir%")
FilePath = windir & "\Temp\userSID.txt"
'Convert supplied file to Ansi_File.txt

Set oFSO = CreateObject("scripting.filesystemobject")
Set oFile = oFSO.GetFile(FilePath)

Set oFileIn = oFSO.OpenTextFile(oFile.Path,ForReading,,TristateTrue)
Set oFileOut = oFSO.CreateTextFile(oFile.ParentFolder & "\ansi_" & oFile.Name,True,False)

oFileOut.Write oFileIn.ReadAll

SID Reader

Const ForReading = 1
Dim objWshShell : Set objWshShell = CreateObject("WScript.Shell")
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Dim str1, Windir
Set objFSO = CreateObject("Scripting.FileSystemObject")
Windir = WshShell.ExpandEnvironmentStrings("%windir%")
Set objFile = objFSO.OpenTextFile(windir & "\Temp\ansi_userSID.txt", ForReading)

Do Until objFile.AtEndOfStream
    strNextLine = objFile.ReadLine
    If Len(strNextLine) > 0 Then
        strLine = strNextLine
    End If
Loop

objFile.Close
'Wscript.Echo strLine
str1 = "HKEY_LOCAL_MACHINE\SOFTWARE\SID\Current_UName\Usersid"

WshShell.Regwrite str1 ,strLine, "REG_SZ"

IniPathLocation

'##############################################
'Getting the Current user registry key value in a variable
On Error Resume Next

strComputer = "."

wbemImpersonationLevelImpersonate = 3
wbemAuthenticationLevelPktPrivacy = 6
Dim strINIPath


Dim objRegistry
Set objRegistry = CreateObject("Wscript.shell")
Set objshell = CreateObject("Wscript.shell")
Set FSO = CreateObject("Scripting.FileSystemObject")


Dim objWshShell : Set objWshShell = CreateObject("WScript.Shell")
'set wshShell = CreateObject("WScript.Shell")

Dim oReg,strHKCU
Dim strKeyParent
Dim ret
Dim strKeyName
Dim arrSubKeys
Dim strAppDataChk
Dim strNotesINI
Dim ConfigIni,ConfigXml
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003

Set WshShell = CreateObject("WScript.Shell")

Set ObjFSO=CreateObject("Scripting.filesyStemObject")

strComputerName = "."

On Error Resume Next
strGUID = WScript.Arguments.Item(0)
strAppDataChk = objWshShell.RegRead("HKEY_USERS\" & strGUID & "\Software\Lotus\Notes\8.0\NotesIniPath")

str1 = "HKEY_LOCAL_MACHINE\SOFTWARE\SID\Current_UName\notesini\path"
WshShell.Regwrite str1 ,strAppDataChk, "REG_SZ"

Folder Size

On Error Resume Next

Dim oFS, oFolder, UserName, path1,UserProf
set oFS = WScript.CreateObject("Scripting.FileSystemObject")
Dim WshShell: Set WshShell = CreateObject("Wscript.Shell")'Declare Global Shell Object
'UserName = WshShell.ExpandEnvironmentStrings ("%USERNAME%")
UserName = WScript.Arguments.Item(0)
NoteFilesPath = WScript.Arguments.Item(1)
UserProf = WshShell.ExpandEnvironmentStrings ("%USERPROFILE%")
path1=chr(34) & UserProf & "\Local Settings\Application Data\Lotus\Notes\Data" & chr(34)
set oFolder = oFS.GetFolder(NoteFilesPath)
'ShowFolderDetails oFolder


sub ShowFolderDetails(oF)
dim F
    wscript.echo  oF.Size

end sub

Dim sh

'msgbox oFolder.Size
Size=oFolder.Size

'msgbox size
size=SizeOnDisk(Size,4096)

Set sh = CreateObject("Wscript.shell")

sh.RegWrite "HKLM\Software\Folder_size\CopyFoldersizeA", Size,"REG_SZ"

Function SizeOnDisk(intFileSize,intClusterSize)
        If (intFileSize <= intClusterSize) Then
                SizeOnDisk = intClusterSize
        Else
                Dim intBase : intBase = intFileSize / intClusterSize
                If Int(intBase) <> intBase Then
                        intBase = int(intBase) + 1
                        SizeOnDisk = (intBase * intClusterSize)
                End If
        End If
 End Function