FSO Dictionary Object
By Administrator on Thursday, July 7th, 2011 | No Comments
'========================================================
' NAME: FSO_Dictionary_Obj1.vbs
' AUTHOR: Neal Walters , Amerisoft Inc
' DATE : 3/26/2005
' http://VBScript-Training.com
'========================================================
Option Explicit
Dim dict, empnum
Set dict = CreateObject("Scripting.Dictionary")
dict.Add 101, "John Doe"
dict.Add 102, "Fred Flinstone"
dict.Add 103, "Wilma Flinstone"
dict.Add 104, "Barnie Rubble"
dict.Add 222, "Betty Rubble"
empnum = -1
Do While empnum <> 0
empnum = InputBox("Type in an employee number:")
If empnum = "" Then
empnum = 0
Exit Do
End If
empnum = CInt(empnum)
WScript.Echo "For empnum=" & empnum & " the employee name = " & dict.Item(empnum)
Loop
'=========================================================
' NAME: FSO_Dictionary_Obj2.vbs
' AUTHOR: Neal Walters , Amerisoft Inc
' DATE : 3/26/2005
' http://VBScript-Training.com
'=========================================================
Option Explicit
Dim dict, empnum, newname, oldname
Set dict = CreateObject("Scripting.Dictionary")
dict.Add 101, "John Doe"
dict.Add 102, "Fred Flinstone"
dict.Add 103, "Wilma Flinstone"
dict.Add 104, "Barnie Rubble"
dict.Add 222, "Betty Rubble"
Dim newkey, newitem
empnum = -1
Do While empnum <> 0
empnum = InputBox("Type in an employee number of the employee you want to change or type in ADD or DEL:",,,1000,6000)
If empnum = "" Then
empnum = 0
WScript.Echo "empnum = 0 so loop is stopping"
Exit Do
End If
If empnum = "ADD" Then
newkey = InputBox ("What is the key for the new employee:",,,1000,6000)
newitem = InputBox ("What is the name for the new employee:,,,1000,6000")
dict.Add newkey, newitem
empnum = -1
ElseIf empnum = "DEL" Then
newkey = InputBox ("What is the key for the employee to be deleted:",,,1000,6000)
dict.Remove cint(newkey)
empnum = -1
Else
empnum = CInt(empnum)
newname = InputBox("Type in new name for employee " & dict.Item(empnum),,,1000,6000 )
oldname = dict.Item(empnum)
dict.Item(empnum)= newname
WScript.Echo "For empnum=" & empnum & " old employee name = " & oldname & _
" and new name = " & newname
End If
Loop
WScript.Echo "Values of all employee names:"
Dim empArray, i, empkeys
empArray = dict.Items ' Get the items/values
empKeys = dict.Keys ' Get the keys
For i = 0 To UBound(empArray) ' Iterate the array.
WScript.Echo i & " empnum=" & empKeys(i) & _
" empname=" & empArray (i)
Next
'========================================================
' NAME: FSO_Dictionary_Obj3.vbs
' AUTHOR: Neal Walters , Amerisoft Inc
' DATE : 3/26/2005
' http://VBScript-Training.com
'========================================================
Option Explicit
Dim dict, empnum, newname, oldname, house1, house2,emp1
Set house1 = CreateObject("Scripting.Dictionary")
Set house2 = CreateObject("Scripting.Dictionary")
Set emp1 = CreateObject("Scripting.Dictionary")
house1.Add "exterior","brick"
house1.Add "trimcolor","white"
house1.Add "sqft",2500
house1.Add "owner","John Doe"
house1.Add "address","123 Main Street"
house1.Add "city","Dallas"
house1.Add "state","TX"
house1.Add "zip","75080"
house2.Add "squarefeet",2500
house2.Add "trimcolor","yellow"
house2.Add "owner","Movie Star"
house2.Add "address","444 Star Island"
house2.Add "city","Miami"
house2.Add "state","FL"
emp1.Add "Name","John Doe"
emp1.Add "City","Naples"
emp1.Add "State","Florida"
printAnyDictionaryObject house1,"House1"
printAnyDictionaryObject house2,"Before Paint: House2"
Painthouse house2,"green"
printAnyDictionaryObject house2,"After Paint: House2"
printAnyDictionaryObject emp1,"Emp1"
WScript.Echo "THE END "
'-------------------------------------------------------
' Nice subroutine to print any dictionary object
'-------------------------------------------------------
sub printAnyDictionaryObject(mydictobj,mydescription)
WScript.Echo "List all values in dictionary object=" & mydescription & VbCrLf
Dim myArray, i, myKeys
myArray = mydictobj.Items ' Get the items/values
myKeys = mydictobj.Keys ' Get the keys
For i = 0 To UBound(myArray) ' Iterate the array.
WScript.Echo i & " key=" & myKeys(i) & _
" value=" & myArray (i)
Next
WScript.Echo " "
End Sub
Sub Painthouse(mydictobj, newcolor)
mydictobj.item("trimcolor") = newcolor
End Sub
Using FSO to Work with Disk Drives
By Administrator on Thursday, July 7th, 2011 | No Comments
'========================================================
' NAME: FSO_Drives_List.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'========================================================
WScript.Echo ShowDriveList
Function ShowDriveList
Dim fso, d, dc, s, n
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.Drives.Item("D:")
n = ""
s = s & d.DriveLetter & " - "
If d.DriveType = Remote Then
n = d.ShareName
ElseIf d.IsReady Then
n = d.VolumeName
End If
s = s & n & VbCrLf
ShowDriveList = s
End Function
'=======================================================
' NAME: FSO_Drives_List.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'=======================================================
WScript.Echo ShowDriveList
Function ShowDriveList
Dim fso, d, dc, s, n
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
numDrives = dc.Count
WScript.Echo "There are " & numDrives & " on this computer."
For Each d In dc
n = ""
s = s & d.DriveLetter & " - "
If d.DriveType = Remote Then
n = d.ShareName
Elseif d.IsReady Then
n = d.VolumeName & " space available = " & FormatNumber(d.FreeSpace / 1024 / 1024,0) & "MB"
End If
s = s & n & VbCrLf
Next
ShowDriveList = s
End Function
'========================================================
' NAME: FSO_Drives_Types.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'========================================================
Option Explicit
Dim driveTypeCDROM, driveTypeFixed, driveTypeRemovable
driveTypeCDROM = 4
driveTypeFixed = 2
driveTypeRemovable = 1
WScript.Echo ShowDriveList
Function ShowDriveList
Dim fso, d, dc, s, n, drvType, numDrives, remote
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
numDrives = dc.Count
WScript.Echo "There are " & numDrives & " on this computer."
For Each d In dc
n = ""
s = s & d.DriveLetter & " - "
If d.DriveType = Remote Then
n = d.ShareName
Elseif d.IsReady Then
n = d.VolumeName & " space available = " & FormatNumber(d.FreeSpace / 1024 / 1024,0) & "MB"
End If
Select Case d.DriveType
Case driveTypeCDROM
drvType = driveTypeCDROM
Case driveTypeFixed
drvType = "Fixed"
Case driveTypeRemovable
drvType = "Removeable"
Case Else
drvType = d.DriveType
End Select
s = s & " type=" & drvType & " "
s = s & n & VbCrLf
Next
ShowDriveList = s
End Function
Using FSO to Read All of a File Into a String Variable
By Administrator on Thursday, July 7th, 2011 | No Comments
'==========================================================
' NAME: FSO_File_ReadAll.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
' ReadAll is sometimes called the "Big Gulp" method,
' because it reads the entire file into a string in one big gulp
'==========================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileName, objFile, myFQFilename, objTextStream, fileContents
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending
forReading = 1
forWriting = 2
forAppending = 8
myFolderName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2"
myFileName = "c:\rating.txt"
If fso.FolderExists(myFolderName) Then
Set objFolder = fso.GetFolder(myFolderName)
WScript.Echo " Folder = " & objFolder.Name
WScript.Echo " DateCreated = " & objFolder.DateCreated
Dim posLastSlash
posLastSlash = InStrRev(myFolderName,"\")
'dirname = "test" len 4 dirname = "test\" len 5 and slash in pos 5
If posLastSlash = Len(myFolderName) Then
'already ends with slash
myFQFilename = myFolderName & myFileName
Else
myFQFilename = myFolderName & "\" & myFileName
End If
WScript.Echo "FQ Filename=" & myFQFilename
If fso.FileExists(myFQFilename) Then
Set objFile = fso.GetFile(myFQFilename)
WScript.Echo "FileSize=" & objFile.Size
Set objTextStream = objFile.OpenAsTextStream (forReading)
fileContents = objTextStream.ReadAll
WScript.Echo "Length=" & len(fileContents)
WScript.Echo "Filename= " & myFileName
WScript.Echo "FileContents = " & VbCrLf & fileContents
Else
WScript.Echo "File " & myFileName & " does not exist."
End If
Else
'If not exist - show the user the error
WScript.Echo "Folder does not exist: " & myFolderName
End If
'========================================================
' NAME: FSO_File_ReadAll2.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'========================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileName, objFile, myFQFilename, objTextStream, fileContents
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending
forReading = 1
forWriting = 2
forAppending = 8
myFileName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FSO_Drive_Objects.txt"
Set objTextStream = fso.OpenTextFile(myFileName, forReading)
fileContents = objTextStream.ReadAll
WScript.Echo fileContents
Using FSO to Read a File
By Administrator on Thursday, July 7th, 2011 | No Comments
'===========================================================
' NAME: FSO_File_ReadAll2.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'===========================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileName, objFile, myFQFilename, objTextStream, fileContents
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending
forReading = 1
forWriting = 2
forAppending = 8
myFileName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FSO_Drive_Objects.txt"
Set objTextStream = fso.OpenTextFile(myFileName, forReading)
fileContents = objTextStream.ReadAll
WScript.Echo fileContents
'==========================================================
' NAME: FSO_File_ReadLineFilter.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'==========================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileName, objTextStream, fileContents, currentLine, lineCounter
Dim BlankLineCounter, filter, wordPosition, linesFoundCounter, LinesNotFoundCounter
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending
forReading = 1
forWriting = 2
forAppending = 8
myFileName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FSO_Drive_Objects.txt"
Set objTextStream = fso.OpenTextFile(myFileName, forReading)
'Read all at once method
' fileContents = objTextStream.ReadAll
' WScript.Echo fileContents
filter = "read"
Do While Not objTextStream.AtEndOfStream
lineCounter = lineCounter + 1
currentLine = objTextStream.ReadLine
If currentLine = "" Then
BlankLineCounter = BlankLineCounter + 1
End If
wordPosition = InStr(ucase(currentLine), ucase(filter))
If wordPosition > 0 Then
WScript.Echo "Line " & lineCounter & ": " & currentLine
linesFoundCounter = linesFoundCounter + 1
Else
LinesNotFoundCounter = LinesNotFoundCounter + 1
End If
Loop
WScript.Echo VbCrLf & " This file contains " & BlankLineCounter & " blank lines out of a total of " & _
lineCounter & " lines."
WScript.Echo " This file contains the phrase: '" & filter & "' on " & _
linesFoundCounter & " lines. "
WScript.Echo " And " & LinesNotFoundCounter & " lines do not contain this phrase."
Using FSO to Write To A File
By Administrator on Thursday, July 7th, 2011 | No Comments
'=============================================================
' NAME: FSO_File_Write.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'=============================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileNameIn, myFileNameOut, objTextStreamIn, objTextStreamOut
Dim fileContents, currentLine, lineCounter
Dim BlankLineCounter, filter, wordPosition, linesFoundCounter, LinesNotFoundCounter
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending, overwrite
forReading = 1
forWriting = 2
forAppending = 8
Overwrite = True
myFileNameIn = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FileIn.txt"
myFileNameOut = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FileOut.txt"
Set objTextStreamIn = fso.OpenTextFile(myFileNameIn, forReading)
fileContents = objTextStreamIn.ReadAll
objTextStreamIn.Close
WScript.Echo "Input File Value=" & VbCrLf & fileContents
Set objTextStreamOut = fso.CreateTextFile(myFileNameOut, Overwrite)
objTextStreamOut.Write "This is my output:" & VbCrLf & fileContents
objTextStreamOut.Close
WScript.Echo "New file has been created "
'===============================================================
' NAME: FSO_File_Write2.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'==============================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileNameIn, myFileNameOut, objTextStream
Dim fileContents, currentLine, lineCounter
Dim BlankLineCounter, filter, wordPosition, linesFoundCounter, LinesNotFoundCounter
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending, overwrite
forReading = 1
forWriting = 2
forAppending = 8
Overwrite = True
myFileNameOut = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\FileOut2.txt"
Set objTextStream = fso.OpenTextFile(myFileNameOut, forReading)
Dim fn, ln, city
Do While Not objTextStream.AtEndOfStream
fn = objTextStream.Read(10)
ln = objTextStream.Read(20)
city = objTextStream.Read(10)
WScript.Echo "fn=" & fn & " ln=" & ln & " city=" & city
Loop
objTextStream.Close
'==========================================================
' NAME: FSO_File_WriteLine.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'===========================================================
Option Explicit
Dim fso, myFolderName, objFolder, myFileName, objTextStream, fileContents, currentLine, lineCounter
Dim BlankLineCounter, filter, wordPosition, linesFoundCounter, LinesNotFoundCounter
Set fso = CreateObject("Scripting.FileSystemObject")
Dim forReading, forWriting, forAppending
forReading = 1
forWriting = 2
forAppending = 8
Dim Overwrite
Overwrite = True
myFileName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\NealDemoWriteLine.html"
Set objTextStream = fso.CreateTextFile(myFileName, Overwrite)
objTextStream.WriteLine "
Heading1
"
objTextStream.WriteLine "
Fred,Flinstone,Bedrock
"
objTextStream.WriteLine "
Barnie,Rubble,Bedrock
"
objTextStream.Close
Using FSO to Recursively Show All (Child) Folders
By Administrator on Thursday, July 7th, 2011 | No Comments
'===========================================================
' NAME: FSO_Recursive.vbs - Recursively List all Folders on Disk Drive
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'===========================================================
Option Explicit
Dim folder, depthLevel
depthLevel = 0
folder = "C:\FSODEMO"
getFolder(folder)
Function getFolder(root)
depthLevel = depthLevel + 1
Dim fso, folders, folder, file, files
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(root) Then
WScript.Echo VbCrLf & "-----------------------------------" & VbCrLf _
& "Folder: " & root & VbCrLf _
& "Depth: " & depthLevel & VbCrLf _
& "-----------------------------------"
For Each file In fso.getFolder(root).files
WScript.Echo "File: " & file & vbTab & "Size: " & DisplaySize(file.size)
Next
For Each folder In fso.getFolder(root).SubFolders
getFolder(fso.GetAbsolutePathName(folder))
Next
Else
WScript.Echo "Folder doesn't exist: " & root
Exit Function
End If
depthLevel = depthLevel - 1
End Function
Function DisplaySize(size)
DisplaySize = FormatNumber(size/1024,0) & "Kb"
End Function
Using FSO to Delete a Folder
By Administrator on Thursday, July 7th, 2011 | No Comments
'=============================================================
' NAME: FSO_Folder_Del.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'=============================================================
Option Explicit
Dim fso, myFolderName, objFolder
Set fso = CreateObject("Scripting.FileSystemObject")
myFolderName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\MyNewDirectory"
If fso.FolderExists(myFolderName) Then
Set objFolder = fso.GetFolder(myFolderName)
WScript.Echo " Folder = " & objFolder.Name
WScript.Echo " DateCreated = " & objFolder.DateCreated
objFolder.Delete
WScript.Echo "Folder has been deleted permanently."
Else
WScript.Echo "Folder does not exist: " & myFolderName
End If
Using FSO to Add a New Folder
By Administrator on Thursday, July 7th, 2011 | No Comments
'============================================================
' NAME: FSO_Folder_Add.vbs
' AUTHOR: Neal Walters
' DATE : 3/26/2005
' http://VBScript-Training.com
'============================================================
Option Explicit
Dim fso, myFolderName, objFolder, myNewFoldername, objFolders
Set fso = CreateObject("Scripting.FileSystemObject")
myFolderName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2"
myNewFolderName = "NealsNewestFolder"
If fso.FolderExists(myFolderName) Then
'Copy Folder Here
Set objFolder = fso.GetFolder(myFolderName)
Set objFolders = objFolder.SubFolders
WScript.Echo " Folder = " & objFolder.Name
WScript.Echo " DateCreated = " & objFolder.DateCreated
objFolders.Add(myNewFoldername)
WScript.Echo "Subfolder " & myNewFoldername & " has been added to the above folder."
Else
'If not exist - show the user the error
WScript.Echo "Folder does not exist: " & myFolderName
End If