vbscript-training.com

FSO Dictionary Object

Administrator — Thu, 07 Jul 2011 17:15:57 +0000


'========================================================
' 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. 
order Amoxil Online Without Prescription 


      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

Administrator — Thu, 07 Jul 2011 17:14:08 +0000


'========================================================
' 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

Administrator — Thu, 07 Jul 2011 17:12:42 +0000


'==========================================================
' 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

Administrator — Thu, 07 Jul 2011 17:11:04 +0000


'===========================================================
' 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

Administrator — Thu, 07 Jul 2011 17:09:52 +0000


'=============================================================
' 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

Administrator — Thu, 07 Jul 2011 17:08:01 +0000



'===========================================================
' 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

Administrator — Thu, 07 Jul 2011 17:07:02 +0000



'=============================================================
' 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

Administrator — Thu, 07 Jul 2011 17:05:45 +0000



'============================================================
' 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

Use FSO to Enumerate (List) Folders on Disk

Administrator — Thu, 07 Jul 2011 17:04:58 +0000


'===========================================================
' NAME: FSOFolders.vbs
' AUTHOR: Neal Walters
' DATE  : 3/26/2005
' http://VBScript-Training.com
'===========================================================
Option Explicit 

WScript.Echo ShowFolderList("c:\Camtasia Studio\VBScript-Training2")
WScript.Echo "------------------"
'WScript.Echo ShowFolderList("c:\")  'Gets permission  denied on some folder 
order Amoxil Online Without Prescription 

?
'WScript.Echo "------------------"

Function ShowFolderList(folderspec)
   Dim fso, f, f1, fc, s
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(folderspec)
   Set fc = f.SubFolders
   For Each f1 In fc
      s = s & f1.name & "Created=" & f1.DateCreated &  " Last Modified:" & f1.DateLastModified
      s = s & " size=" & f1.size
      s = s & VbCrLf
   Next
   ShowFolderList = s
End Function

'============================================================
' 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 

'=============================================================
' NAME: FSO_Folder_Add_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 

'==============================================================
' NAME: FSO_Folder_Copy.vbs
' AUTHOR: Neal Walters
' DATE  : 3/26/2005
' http://VBScript-Training.com
'==============================================================
Option Explicit 

   Dim fso, myFolderName, objFolder, myCopyFoldername
   Set fso = CreateObject("Scripting.FileSystemObject")

   myFolderName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\DirTest"
   myCopyFolderName = "c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2\DirMyCopy" 

   If fso.FolderExists(myFolderName) Then
   'Copy Folder Here
	   Set objFolder = fso.GetFolder(myFolderName) 

	   WScript.Echo " Folder = " & objFolder.Name
	   WScript.Echo " DateCreated = " & objFolder.DateCreated 

	   objFolder.Copy (myCopyFoldername) 

	   WScript.Echo "Folder has been copied." 

   Else
   'If not exist - show the user the error
       WScript.Echo "Folder does not exist: " & myFolderName 

   End If 

'==========================================================================
' 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 

'===========================================================
' 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 Enumerate All Files in a Folder

Administrator — Thu, 07 Jul 2011 17:02:52 +0000


'============================================================
' NAME: FSOFilesInFolder.vbs
' AUTHOR: Neal Walters
' DATE  : 3/26/2005
' http://VBScript-Training.com
'=============================================================
Option Explicit 

WScript.Echo ShowFolderList("c:\Documents and Settings\nwalters\My Documents\Camtasia Studio\VBScript-Training2")
WScript.Echo "------------------"
'WScript.Echo ShowFolderList("c:\")  ' Gets permission denied on some folder 
order Amoxil Online Without Prescription 

?
'WScript.Echo "------------------"

Function ShowFolderList(folderspec)
   Dim fso, f, f1, fc, s
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(folderspec)

   Set fc = f.Files
   s = " There are " & fc.Count & " files in this directory." & VbCrLf & VbCrlf
   For Each f1 In fc
      s = s & "filename=" & f1.name & " Created=" & f1.DateCreated &  " Last Modified:" & f1.DateLastModified
      s = s & " size=" & f1.size & " path=" & f1.path
      s = s & VbCrLf
   Next
   ShowFolderList = s
End Function

VBScript to Control Excel Spreadsheet

Administrator — Thu, 07 Jul 2011 17:00:39 +0000


'==============================================================
' NAME: VBSCriptControlExcel.vbs
' AUTHOR: Neal Walters
' DATE  : 3/19/2006
' http://VBScript-Training.com
'
'==============================================================

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "Fred Flinstone"
objExcel.Cells(1, 2).Value = "Bedrock"
objExcel.Cells(2, 1).Value = "Barnie Rubble"
objExcel.Cells(2, 2).Value = "Bedrock" 

objExcel.Cells(1, 1).Font.Bold = TRUE
objExcel.Cells(1, 1).Font.Size = 14
objExcel.Cells(1, 1).Font.ColorIndex = 3

RegEx (Regular Expressions)

Administrator — Thu, 07 Jul 2011 16:59:09 +0000


'===========================================
' NAME: VBSCriptControlExcel.vbs
' AUTHOR: Neal Walters
' DATE  : 3/19/2006
' http://VBScript-Training.com
'
' Related Regular Expression (RegEx) Websites:
'http://www.regular-expressions.info/
'http://regxlib.com/
'  RegEx tester: http://regxlib.com/RETester.aspx
'===========================================
'-------Loop and show each match  -------------

'http://www.microsoft.com/technet/scriptcenter/resources/qanda/apr05/hey0415.mspx 

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.Pattern = "\d{4}"

strSearchString = "John=1234 Fred=5678  Susan=1212"

WScript.Echo "SearchString=" & strSearchString
Set colMatches = objRegEx.Execute(strSearchString)  

If colMatches.Count > 0 Then
   strMessage = "The following user accounts were found:" & vbCrlf
   For Each strMatch In colMatches
       strMessage = strMessage &  strMatch.Value & " (character position=" &  _
           strMatch.FirstIndex & ")" & vbCrLf
   Next
Else
   WScript.Echo "No matches found"
End If

Wscript.Echo strMessage
'WScript.Quit 

'-------Simple True/False Match -------------

'http://www.brettb.com/VBScriptRegularExpressions.asp 

strSearchString = "Have you seen Microsoft.com web site lately?"
objRegEx.Pattern = "(.com|.org)"
objRegEx.IgnoreCase = True
objRegEx.Global = True
'Global property should be set to True if the search should match all occurrences of
'the pattern,
'or False if just the first occurrence should be matched:

expressionmatch = objRegEx.Test(strSearchString)

WScript.Echo "SearchString=" & strSearchString
WScript.Echo "Pattern=" & objRegEx.Pattern
WScript.Echo "express match = " & expressionmatch 

'-------Replace -------------

InitialString = "www.foo.co.uk  and www.zoo.co.uk" 

objRegEx.Pattern = ".co.uk"
objRegEx.IgnoreCase = True
objRegEx.Global = True
ReplacedString = objRegEx.Replace(InitialString, ".com")

WScript.Echo "Replaced " & InitialString & " with " & ReplacedString
'WScript.Quit 

'------ Strip HTML -------
'Create function  

HTMLString = "This is "  & _
   "some  HTML"
WScript.Echo "OriginalHTML=" & HTMLString
WScript.Echo "After Regex=" & StripHTMLTags(HTMLString)

Function StripHTMLTags(HTMLString)
  objRegEx.Pattern = "<[^>]+>"
  objRegEx.IgnoreCase = True
  objRegEx.Global = True

   stripHTMLtags = objRegEx.Replace(HTMLstring, "")
End Function