以下是一些VBScript操作Excel的实例，比如如何通过VbS打开Excel，新建Excel、Sheet，删除

Sheet，另存Excel文件，在指定的Sheet Cells中写入以及读取Sheet中usedRange中的内容。

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example1
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 打开Excel文件
'==========================================================================
Dim xlsApp,xlsWorkBook,xlsSheet
Dim iRowCount,numAdd
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\data.xls") '打开指定路径的Excel表格
Set xlsSheet = xlsWorkBook.Sheets("sheet1") '选择指定Sheet1
iRowCount = xlsSheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数
For iLoop = 2 To iRowCount
numAdd = xlsSheet.Cells(iLoop,1) '取Cells中的值
MsgBox iLoop '显示第一列从第二行开始到iLoop行为止。
Next
xlsWorkBook.Save
xlsWorkBook.Close
xlsApp.Quit
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example2
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 打开Excel文件
'==========================================================================
rem 打开Excel文件,Excel及sheet2需预先建立，不然找不到要打开的文件
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\weibin\2010.xls")'打开指定路径的Excel表格
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsSheet = xlsApp.Sheets.Item("Sheet2")'选择指定Sheet2
xlsWorkBook.Save '保存工作表
'xlsApp.Quit '退出Excel对象
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 将上面的一段程序封装成Function函数，Exel文件路径作为参数。
Function OPenExcelFile(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
Set xlsWorkBook = xlsApp.Workbooks.Open (FilePath)'打开指定路径的Excel表格
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsSheet = xlsApp.Sheets.Item("Sheet2")'选择指定Sheet2页
xlsWorkBook.Save '保存工作表
'xlsApp.Quit '退出Excel对象
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example3
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 另存Excel文件
'==========================================================================
rem 新建Excel文件并保存到一个指定位置，并在Sheet2中写入值
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '定义一个Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(2) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
xlsSheet.Cells(1,1).Value = "Hello World!" '在单元格录入Hello World
xlsApp.ActiveWorkbook.SaveAs ("d:\test.xls") '保存工作表
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 将上面的一段程序封装成Function函数，Exel文件路径作为参数。
Function CreateExcelFile(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet

Set xlsApp = WScript.CreateObject("Excel.Application") '定义一个Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(2) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
xlsSheet.Cells(1,1).Value = "Hello World!" '在单元格录入Hello World
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存工作表
xlsApp.Quit '退出

Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example4
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 添加新的Sheets并且命名另存
'==========================================================================
rem excel新建，sheet新建，重命名后另存
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
Set xlsSheet = xlsWorkBook.Sheets.Add() '新建一新Sheet
xlsSheet.name "Practise" '新Sheet命名为Practise
xlsSheet.activate '激活sheet
xlsSheet.range("A1:B5").Value = "Hello World" '在新sheet range A1至B5中中写入Hello World
xlsApp.ActiveWorkbook.SaveAs "D:\weibin\Hope.xls" '保存Excel至D:\weibin
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 封装AddSheets函数
Function AddSheets(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
Set xlsSheet = xlsWorkBook.Sheets.Add() '新建一新Sheet
xlsSheet.name "Practise" '新Sheet命名为Practise
xlsSheet.activate '激活sheet
xlsSheet.range("A1:B5").Value = "Hello World" '在新sheet range A1至B5中中写入Hello World
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存Excel至D:\weibin
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
AddSheets "c:\weibin\hope.xls"

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example5
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 删除新建Excel指定的Sheet
'==========================================================================
Rem 删除指定的Sheet1,设定不同的n，可以删除不同的Sheet
Function DeleteSheet(n)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
xlsWorkBook.Worksheets("Sheet"&n).Delete
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
DeleteSheet(1)

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example6
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 创建，写入，保存Excel文件
'==========================================================================
Function CreateWriteSaveAsExcelFile(n,i,j,FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
Set xlsWorkBook = xlsApp.Workbooks.Add()  '新建一Excel实例
xlsapp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(n) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
' xlsWorkBook.Worksheets("Sheet1").activate '与上一句有相同功能
xlsSheet.Cells(i,j).Value = "For Testing" '在单元格录入For Testing
' xlsWorkBook.Worksheets("Sheet2").Cells(1,1).Value = "For Testing" '与上一句有相同功能
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存工作表
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
CreateWriteSaveAsExcelFile (1,2,2,"c:\weibin\Practice.xls")

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME: Example7
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-3-10
' COMMENT: 比较InsuredNo，若相同写入新创建的Sheet中

'==========================================================================
Option Explicit
On Error Resume Next
'定义相关变量
Dim xlsApp,xlsWorkBook,xlsSheet
Dim iRowCount
Dim a()
Dim b()
Dim oLoop,xLoop,jLoop
Dim i
Dim rowCount

Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\tmp001.xlsx") '打开指定路径的Excel表格
Set xlsSheet = xlsWorkBook.Sheets.add()'
xlsWorkBook.ActiveSheet.Name = "Collection"
xlsSheet.Cells(1,1).Value = "InsuredNo"
xlsSheet.Cells(1,2).Value = "ContNo"
xlsWorkBook.ActiveSheet.Rows(1).Font.Bold = True

Set xlsSheet = xlsWorkBook.Sheets("SQL Results") '选择指定Sheet1
iRowCount = xlsSheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数

'声明动态数组变量并分配或重新分配存储空间
WScript.Echo "通知:声明动态数组变量并分配或重新分配存储空间开始，请等待!"
ReDim a(iRowCount-2)
ReDim b(iRowCount-2)
WScript.Echo "通知:声明动态数组变量并分配或重新分配存储空间成功!"

'文件中逐行读取，并记录数到组a，b中
WScript.Echo "通知:读取InsuredNo和ContNo到数组a,b开始!，读取完后有提示，请耐心等待!"
For Loop = 0 To iRowCount - 2
a(oLoop)= xlsSheet.Cells(oLoop + 2,27).Value
b(oLoop)= xlsSheet.Cells(oLoop + 2,3).Value
Next
WScript.Echo "通知:读取InsuredNo和ContNo到数组a,b成功!"
 
' 比较InsuredNO
WScript.Echo "通知:数据筛选开始，请耐心等待!"
Set xlsSheet = xlsWorkBook.Sheets("Collection") '选择指定Sheet1
For xLoop = 0 To iRowCount - 2
For jLoop = xLoop + 1 To iRowCount - 2
If a(xLoop) = a(jLoop) Then
xlsApp.Worksheets("Collection").Cells(xLoop + 2,1).Value = a(jLoop)
xlsApp.Worksheets("Collection").Cells(xLoop + 2,2).Value = b(jLoop)
End If
Next
Next
WScript.Echo "通知:数据筛选完成，并写入Excel中成功!"
xlsWorkBook.Save
xlsWorkBook.Close
xlsApp.Quit
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsSheet = Nothing '释放内存
WScript.Echo "通知:保存并关闭Excel，释放内存成功!"

Option Explicit
On Error Resume Next
Dim colDrives 'the collection that comes from WMI
Dim drive   'an individual drive in the collection

Const DriveType = 3 'Local drives. From the SDK
Set colDrives =_
GetObject("winmgmts:").ExecQuery("select size,freespace " &_
 "from Win32_LogicalDisk where DriveType =" & DriveType)

For Each drive In colDrives 'walks through the collection
WScript.Echo "Drive: " & drive.DeviceID
WScript.Echo "Size: " & drive.size
WScript.Echo "Freespace: " & drive.freespace
Next

'Create a FSO instance,then create FSO perpoty,using For Each function to get the drives info

'This is another method to get the drives information for current machine
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive In colDrives
If objDrive.IsReady = True Then
Wscript.Echo "Drive letter: " & objDrive.DriveLetter
Wscript.Echo "Free space: " & objDrive.FreeSpace
Else
Wscript.Echo "Drive letter: " & objDrive.DriveLetter
End If
Next

'call the function CreateFolderandFile
CreateFolderandFile "folder1","folder2"

Function CreateFolderandFile(folder1,folder2)
Dim objFSO,objFolder,objFile
Set bjFSO=CreateObject("Scripting.FileSystemObject")
'seach the folder,if exist delete,or create
If (objFSO.FolderExists("folder1")and objFSO.FolderExists("folder2")) Then
objFSO.DeleteFolder("folder1")
objFSO.DeleteFolder("folder2")
Else
objFSO.CreateFolder("folder1")
objFSO.CreateFolder("folder2")
End If
'create txt file under the directory,if exist delete,or create
If objFSO.FileExists("folder1\ScriptLog.txt") Then
objFSO.DeleteFile("folder1\ScriptLog.txt")
Else
objFSO.CreateTextFile("folder1\ScriptLog.txt")
End If
'open the txt file and writing
Set bjFile=objFSO.OpenTextFile("folder1\ScriptLog.txt",ForWriting)
objFile.WriteBlankLines(2) 'writing blanklines
objFile.Write (InputBox("Please input the character","Write operation",vbYesNo))'input for user
objFile.WriteLine("This is an example for writing txt file")'write the string to file
objFSO Now 'write the current time
objFile.Close
objFSO.MoveFile "folder1\ScriptLog.txt","folder2\"'move the file to folder2
Set bjFile=objFSO.OpenTextFile("folder2\Script.txt",ForAppending)'appending content
objFile.WriteLine("This is appending line")
Wscript.Echo "Reading file beginning:"
Do While objFile.AtEndOfStream = False
strLine = objFile.ReadLine
objFile.Close
Wscript.Echo strLine
Loop
End Function

1) 试验Inputbox的第三个参数

Dim name,msg
msg="Plase input your name:"
name=Inputbox(msg,"name","lily")
Msgbox(name)
 

2) 写一段程序输出你的年龄

Dim MyAge,RmndrMsg
RmndrMsg = "Please input your age"
MyAge = InputBox (RmndrMsg,"Age","0")
MsgBox "Your Age is: "& MyAge,vbYesNo,"Your Age"
3) 写一段程序进行3次输入, 分别输入你和你父母的姓名(要求显示提示), 并分3次输出

Dim name,msg
msg = "Please input your name"
name = InputBox(msg,"Name","")
MsgBox(name)

msg = "Please input your father name"
name = InputBox(msg,"Name","")
MsgBox(name)

msg = "Please input your mother name"
name = InputBox(msg,"Name","")
MsgBox(name)

Dim msg(2)
msg(0) = "Please input your name"
msg(1) = "Please input your father name"
msg(2) = "Please input your mother name"
For i = 0 To UBound(msg)
name = InputBox(msg(i),"name","")
MsgBox(name)
Next

3) 编一个程序, 计算圆形的面积, 半径由用户给出 (使用Inputbox) PI取值3.14159

Dim r,s
Const PI = 3.14159
r = InputBox("Please input the radius","radius","0.0")
s = PI*r^2
MsgBox "The area is: " & s ,vbYesNo,"Circle Area"

4) 编一个程序取得20 / 3 的余数
Dim Getvalue
Getvalue = 20 Mod 3
WScript.Echo  Getvalue

5) 把5以内的正整数都转换成中国大些数字

Do
Call MyValue(InputValue())
Loop Until MyValue(InputValue()) <> vbRetry

Function InputValue()
Dim i
i = InputBox("请输入1到5的数字:")
InputValue = i

End Function  

Function MyValue(i)
Dim DefResp
Select Case i
Case 1
DefResp = MsgBox ("壹",vbRetryCancel,"中文大写")
If DefResp<>vbRetry  Then
Exit Function
End If

Case 2
DefResp = MsgBox ("贰",vbRetryCancel,"中文大写")
If DefResp<>vbRetry  Then
Exit Function
End If

Case 3
DefResp = MsgBox ("叁",vbRetryCancel,"中文大写")
If DefResp<>vbRetry  Then
Exit Function
End If

Case 4
DefResp = MsgBox ("肆",vbRetryCancel,"中文大写")
If DefResp<>vbRetry  Then
Exit Function
End If

Case 5
DefResp = MsgBox ("伍",vbRetryCancel,"中文大写")
If DefResp<>vbRetry  Then
Exit Function
End If

Case Else
MsgBox("输入错误，请重新输入!")
If DefResp<>vbRetry  Then
Exit Function
End If
End Select
MyValue = DefResp
End Function

Function ButtonValue(DefResp)
If DefResp<>vbRetry Then
Exit Function
Else
InputValue()
End If
End Function

6) 在我国的数学经典著作"九章算术"中有这样一道题:百钱买百鸡, 公鸡5钱一只, 母鸡3钱一只, 小鸡1钱2只(这个数据我是参考一本编程书的, 但我记得是公3,母1,小1钱3只? 不管了, 就按照书上得来吧)求得是能有多少种办法买这些鸡. 如果看不懂的话我用大白话说说:有人要去买鸡, 用100块钱正好买了100只鸡, 价格如下:公:5$, 母:3$, 小:1$ for 2, 让你求一共多少种卖法(公母小怎么搭配). 请用循环解决这个问题.

'设公鸡为x只，母鸡为y只，小鸡为z只
Dim x,y,z
Dim str
str = ""
count = 0
StartTime = Timer
For x = 0 To 20
For y = 0 To Int(100/3)
For z = 0 To 100
If 5*x + 3*y + 0.5*z = 100 And x + y + z = 100 Then
str = "公鸡"& x & "只"& VbCrLf & "母鸡"& y & "只" & VbCrLf & "小鸡"& z & "只" & VbCrLf
count = count + 1
wscript.echo str
End If
Next
Next
Next
EndTime = Timer
WScript.Echo "总共消耗时间" & EndTime - StartTime & "秒"
wscript.echo "共有"& count&"种买法"

7) 定义一个数组, 包含5个元素,　都是随机整数(随便输入), 要求把他们按照从大到小的顺序排列起来

Dim i,j,t
Dim Array(4)
Dim MySequence(4)

'手动输入数值，压入数组
For i=0 To 4
Array(i)=InputBox("请输入第"&i+1&"数据")'数据是整数
Next

For i=0 To 4 '四次比较
For j=i To 4 '五个数值
If Array(i)<Array(j) Then
' 如果第一个值小于第二个值，引入变量t，第一第二两个值进行互换，较大值放在首位
' 继续将放在首位的较大值与第三个值比较，一次类推。。内层循环结束，最大值已经处在首位子
t=Array(i)    
Array(i)=Array(j)
Array(j)=t
End If
Next
MySequence(i)=Array(i)

Next
WScript.Echo MySequence(0) &VbCrLf _
            &MySequence(1) &VbCrLf _
            &MySequence(2) &VbCrLf _
            &MySequence(3) &VbCrLf _
            &MySequence(4) &VbCrLf _

8) 有两个二维数组a(4,4)和b(4,4) (元素值随便), 交换两个数组(原来的a的所有元素值变成b的, b的所有元素值变成a的),因为4行4列的二维数组输出比较麻烦，现以二行二列的数组为例
Dim MyArray1(2,2)
Dim MyArray2(2,2)
Dim z
For i=0 To 1
For j=0 To 1
MyArray1(i,j)=InputBox("请输入第("&i&","&j&")个整数")'手动输入数据，压入二维数值
Randomize
MyArray2(i,j)=CInt(Rnd*1000+1)'生成随机二维数组
Next
Next
WScript.Echo MyArray1(0,0)&"**"&MyArray1(0,1)&"**"&MyArray1(1,0)&"**"&MyArray1(1,1)
WScript.Echo MyArray2(0,0)&"**"&MyArray2(0,1)&"**"&MyArray2(1,0)&"**"&MyArray2(1,1)

For x=0 To 1
For y=0 To 1

z=MyArray1(x,y)
MyArray1(x,y)=MyArray2(x,y)
MyArray2(x,y)=z
Next
Next
WScript.Echo MyArray1(0,0)&"**"&MyArray1(0,1)&"**"&MyArray1(1,0)&"**"&MyArray1(1,1)
WScript.Echo MyArray2(0,0)&"**"&MyArray2(0,1)&"**"&MyArray2(1,0)&"**"&MyArray2(1,1)

Namespaces contain objects, and these objects contain properties you can manipulate. Let's use a WMI script, ListWMINamespaces.vbs, to illustrate just how the WMI namespace is organized.

ListWMINamespaces.vbs

Option Explicit
Dim objSWbemServices
Dim colNameSpaces
Dim objNameSpace
Dim strComputer

strComputer = "."Set bjSWbemServices = GetObject("WinMgmts:\\" & strComputer & "\root")
Set colNameSpaces = objSwbemServices.InstancesOf("__NAMESPACE")
For Each objNameSpace In colNameSpaces
    WScript.Echo objNameSpace.Name
Next

Knowing the default namespaces gives some information, and though it's helpful, to better map out the WMI namespace, you'll want information about the child namespaces as well. You'll need to implement a recursive query so that you can gain access to the child namespace data.

RecursiveListWMINamespaces.vbs

WScript.Echo(Now)
strComputer = "."
Call EnumNamespaces("root")

Sub EnumNamespaces(strNamespace)
    WScript.Echo strNamespace
    Set bjSWbemServices = _
        GetObject("winmgmts:\\" & strComputer & "\" & strNamespace)
    Set colNamespaces = objSWbemServices.InstancesOf("__NAMESPACE")
    For Each objNameSpace In colNamespaces
        Call EnumNamespaces(strNamespace & "\" & objNamespace.Name)
    Next
End sub
WScript.Echo("all done " & Now)

Creating Files

Option Explicit
On Error Resume Next
Dim LogFile 'holds path to the log file
Dim objFSO 'holds connection to the FileSystemObject
Dim objFile 'used by OpenTextFile command to allow writing to file

LogFile = "C:\FSO\fso.txt"
Const ForWriting = 2
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjFile = objFSO.OpenTextFile(LogFile,ForWriting)
objFile.WriteLine "beginning logging " & Now
objFile.WriteLine "working on process " & Now
objFile.WriteLine "Logging completed at " & Now
objFile.Close

Creating a Log File

Chapter 6 Quick Reference

Option Explicit
On Error Resume Next
Dim LogFile 'holds path to the log file
Dim objFSO 'holds connection to the FileSystemObject
Dim objFile 'used by OpenTextFile command to allow writing to file

LogFile = "C:\FSO\fso.txt"
Const ForWriting = 2
Const ForAppending = 8
Set bjFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(LogFile) Then
Set bjFile = objFSO.OpenTextFile(LogFile,ForAppending)
objFile.Write "appending " & Now
Else
Set bjFile = objFSO.CreateTextFile(LogFile)
objFile.write "writing to new file " & Now
End If
objFile.Close

There are actually three different ways you can write to files. These methods are described in Table 6-4.

FileAttributes.vbs

Option Explicit
On Error Resume Next
Dim objFSO
Dim objFile
Dim Target

Target = "C:\fso\test.txt"
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjFile = objFSO.GetFile(Target)

WScript.Echo "The file is: " & target
WScript.Echo "bitmap number is: " & objFile.Attributes & _
   " " & funAttrib(objFile.attributes)


Function funAttrib(intMask)
Dim strAttrib
If IntMask = 0 Then strAttrib = "No attributes"
If intMask And 1 Then strAttrib = strAttrib & "Read Only, "
If intMask And 2 Then strAttrib = strAttrib & "Hidden, "
If intMask And 4 Then strAttrib = strAttrib & "System, "
If intMask And 8 Then strAttrib = strAttrib & "Volume, "
If intMask And 16 Then strAttrib = strAttrib & "Directory, "
If intMask And 32 Then strAttrib = strAttrib & "Archive, "
If intMask And 64 Then strAttrib = strAttrib & "Alias, "
If intMask And 2048 Then strAttrib = strAttrib & "Compressed, "
funAttrib = strAttrib
End Function

Additional file object properties can be retrieved in the same manner. All are listed in Table 6-2.

In your first file system script, ListFiles.vbs, connect to FileSystemObject, attach it to a folder defined by the variable FolderPath, and then use the Files command to enable the For Each loop to echo out each file in the folder. This is just the beginning of what can be done with this script.

ListFiles.vbs

Option Explicit
On Error Resume Next
Dim FolderPath        'path to the folder to be searched for files
Dim objFSO            'the FileSystemObject
Dim objFolder         'the folder object
Dim colFiles          'collection of files from files method
Dim objFile           'individual file object

FolderPath = "c:\fso"
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files

For Each objFile in colFiles
  WScript.Echo objFile.Name, objFile.Size & " bytes"
  WScript.Echo VbTab & "created: " & objFile.DateCreated
  WScript.Echo VbTab & "modified: " & objFile.DateLastModified
Next

one function to offer the objpath

Sub subGetFolder
Dim objShell, objFolder, objFolderItem, objPath
Const windowHandle = 0
Const folderOnly = 0
const folderAndFiles = &H4000&

Set bjShell = CreateObject("Shell.Application")
Set bjFOlder = objShell.BrowseForFolder(windowHandle, _
   "Select a folder:", folderOnly)
Set bjFolderItem = objFolder.Self
bjPath = objFolderItem.Path
End Sub

Chapter 5 Quick Reference

YourNameDictionary.vbs

Option Explicit
Dim objDictionary   'the dictionary object
Dim objFSO          'the FileSystemObject object
Dim objFolder       'created by GetFolder method
Dim colFiles        'collection of files from Files method
Dim objFile         'individual file
Dim aryKeys         'array of keys
Dim strKey          'individual key from array of keys
Dim strFolder       'the folder to obtain listing of files

strFolder = "c:\windows"
Set bjDictionary = CreateObject("Scripting.Dictionary") 'connect dictionary
Set bjFSO = CreateObject("Scripting.FileSystemObject") ' connect filesystemobject
Set bjFolder = objFSO.GetFolder(strFolder) 'get path "c:\windows" all folders
Set colFiles = objFolder.Files
For Each objFile In colFiles  'using for each next to throgh all items with the files
objDictionary.Add objFile.Name, objFile.Size
Next
aryKeys = objDictionary.Keys
For Each strKey In aryKeys
WScript.Echo "The file: " & strKey & " is: " & _
objDictionary.Item(strKey) & " bytes"
Next
WScript.Echo "Directory listing of " & strFolder
WScript.Echo "***there are " & objDictionary.count & " files"

SearchTXT.vbs

Option Explicit
On Error Resume Next
Dim arrTxtArray()
Dim myFile
Dim SearchString
Dim objTextFile
Dim strNextLine
Dim intSize
Dim objFSO
Dim i
intSize = 0
myFile = "c:\windows\setuplog.txt" <'>Modify as required
SearchString = "Error"
Const ForReading = 1
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjTextFile = objFSO.OpenTextFile _
  (myFile, ForReading)
Do until objTextFile.AtEndOfStream
  strNextLine = objTextFile.ReadLine
  if InStr (strNextLine, SearchString)then
   ReDim Preserve arrTxtArray(intSize)
   arrTxtArray(intSize) = strNextLine
   intSize = intSize + 1
  End If
Loop
objTextFile.close
For i = LBound(arrTxtArray) To UBound(arrTxtArray)
   WScript.Echo arrTxtArray(i)
Next
WScript.Echo("all done")

ParseAppLog.vbs

Table 5-2. Variables declared in ParseAppLog.vbs
Variable
Use
arrTxtArray()
Declares a dynamic array
appLog
Holds the file name of the file to open
SearchString
Holds the string to search for
objTextFile
Holds the connection to the text file
strNextLine
Holds the next line in the text stream
intSize
Holds the initial size of the array
objFSO
Holds the connection to the file system object
i
Used to increment the intSize counter
ErrorString
Holds the second search string used
newArray
New array created to sort the output

Option Explicit
On Error Resume Next
Dim arrTxtArray()
Dim appLog
Dim SearchString
Dim objTextFile
Dim strNextLine
Dim intSize
Dim objFSO
Dim i
Dim ErrorString
Dim newArray
intSize = 0
appLog = "applog.csv" <'>Ensure in path
SearchString = ","
ErrorString = "1004"
Const ForReading = 1
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjTextFile = objFSO.OpenTextFile _
  (appLog, ForReading)
Do until objTextFile.AtEndOfStream
  strNextLine = objTextFile.ReadLine
  if InStr (strNextLine, SearchString)Then
   If InStr (strNextLine, ErrorString) then
         ReDim Preserve arrTxtArray(intSize)
         arrTxtArray(intSize) = strNextLine
         intSize = intSize + 1
     End If
  End If
Loop
   objTextFile.close
For i = LBound(arrTxtArray) To UBound(arrTxtArray)
   If InStr (arrTxtArray(i), ",") Then
   newArray = Split (arrTxtArray(i), ",")
         WScript.Echo "Date: " & newArray(0)
         WScript.Echo "Time: " & newArray(1)
         WScript.Echo "Source: " & newArray(2)& " "& newArray(3)
         WScript.Echo "Server: " & newArray(7)
         WScript.Echo "Message1: " & newArray(8)
         WScript.Echo "Message2: " & newArray(9)
         WScript.Echo "Message3: " & newArray(10)
         WScript.Echo " "
   End If
Next
WScript.Echo("all done")

Q.
What is the advantage of using a dynamic array?
A.
You can expand a dynamic array when a new element is needed. This saves memory and is more efficient.
Q.
How is ReDim Preserve used?
A.
ReDim Preserve is used to resize a dynamic array while ensuring that the data contained in the array is not lost.

Q.
What is the simplest way to break up a CSV data stream to populate an array?
A.
You need to use the Split command and look for commas.
Q.
What is the InStr command used for?
A.
The InStr command is used to look for character combinations in a stream of text.
Q.
What construct can be used to hold data records that are separated by commas?
A.
A multidimensional array can be used to hold this type of data.

To create a two-dimensional array, include both dimensions when you declare the variable used for the array, as illustrated here:

Dim a (3,3)

Table 4-2. Two-dimensional array
0,0
0,1
0,2
0,3
1,0
1,1
1,2
1,3
2,0
2,1
2,2
2,3
3,0
3,1
3,2
3,3

WorkWith2DArray.vbs

Option Explicit
Dim i
Dim j
Dim numLoop
Dim a (3,3)
numLoop = 0
For i = 0 To 3
  For j = 0 To 3
    numLoop = numLoop+1
    WScript.Echo "i = " & i & " j = " & j
    a(i, j) = "loop " & numLoop
    WScript.Echo "Value stored In a(i,j) is: " & a(i,j)
  Next
Next

execute result

C:\>cscript. example.vbs
Microsoft (R) Windows Script. Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

i = 0 j = 0
Value stored In a(i,j) is: loop 1
i = 0 j = 1
Value stored In a(i,j) is: loop 2
i = 0 j = 2
Value stored In a(i,j) is: loop 3
i = 0 j = 3
Value stored In a(i,j) is: loop 4
i = 1 j = 0
Value stored In a(i,j) is: loop 5
i = 1 j = 1
Value stored In a(i,j) is: loop 6
i = 1 j = 2
Value stored In a(i,j) is: loop 7
i = 1 j = 3
Value stored In a(i,j) is: loop 8
i = 2 j = 0
Value stored In a(i,j) is: loop 9
i = 2 j = 1
Value stored In a(i,j) is: loop 10
i = 2 j = 2
Value stored In a(i,j) is: loop 11
i = 2 j = 3
Value stored In a(i,j) is: loop 12
i = 3 j = 0
Value stored In a(i,j) is: loop 13
i = 3 j = 1
Value stored In a(i,j) is: loop 14
i = 3 j = 2
Value stored In a(i,j) is: loop 15
i = 3 j = 3
Value stored In a(i,j) Is: Loop 16

ArrayReadTxtFile.vbs

through the split function to create a single dimension array and When you use the suffixes (0) and (i) in the WScript.Echo statement, VBScript. knows you want to refer to elements in the array

Option Explicit
Dim objFSO
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i
Const ForReading = 1
Set bjFSO = CreateObject("Scripting.FileSystemObject")
Set bjTextFile = objFSO.OpenTextFile("c:\Test.txt",ForReading)

Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.ReadLine
arrServiceList = Split(strNextLine,",")
WScript.Echo arrServiceList(0)
Loop

For i = 1 To UBound(arrServiceList)
WScript.Echo arrServiceList(i-1)
Next

WScript.Echo ("all done")

BasicArrayForEachNext.vbs

Option Explicit
On Error Resume Next
Dim myTab 'Holds custom tab of two places
Dim aryComputer 'Holds array of computer names
Dim computer    'Individual computer from the array
Dim I           'Simple counter variable. Used to retrieve by
                'Element number in the array.
myTab = Space(2) 'two blankspaces
i = 0           'The first element in an array is 0.
aryComputer = array("s1","s2","s3")

WScript.Echo "Retrieve via for each next"
For Each computer In aryComputer
         WScript.Echo myTab & "computer # " & i & _
         " is " & computer
   i = i+1
Next

Option Explicit
On Error Resume Next
Dim myTab 'Holds custom tab of two places
Dim aryComputer 'Holds array of computer names
Dim computer    'Individual computer from the array
Dim i           'Simple counter variable. Used to retrieve by
                'Element number in the array.
myTab = Space(2)
i = 0           'The first element in an array is 0.
aryComputer = array("s1","s2","s3")


WScript.Echo "Retrieve via for next"
i = 0
For i = 0 To UBound(aryComputer)
   WScript.Echo myTab & "computer # " & i & _
         " is " & aryComputer(i)
Next

from

BasicArrayForEachNext.vbs

Option Explicit
On Error Resume Next
Dim myTab 'Holds custom tab of two places
Dim aryComputer 'Holds array of computer names
Dim computer    'Individual computer from the array
Dim I           'Simple counter variable. Used to retrieve by
                'Element number in the array.
myTab = Space(2) 'two blankspaces
i = 0           'The first element in an array is 0.
aryComputer = array("s1","s2","s3")

WScript.Echo "Retrieve via for each next"
For Each computer In aryComputer
         WScript.Echo myTab & "computer # " & i & _
         " is " & computer
   i = i+1
Next

Option Explicit
On Error Resume Next
Dim myTab 'Holds custom tab of two places
Dim aryComputer 'Holds array of computer names
Dim computer    'Individual computer from the array
Dim i           'Simple counter variable. Used to retrieve by
                'Element number in the array.
myTab = Space(2)
i = 0           'The first element in an array is 0.
aryComputer = array("s1","s2","s3")


WScript.Echo "Retrieve via for next"
i = 0
For i = 0 To UBound(aryComputer)
   WScript.Echo myTab & "computer # " & i & _
         " is " & aryComputer(i)
Next

from

YourNameCheckNamedArgCS.vbs

Option Explicit
'On Error Resume Next
Dim computerName
Dim serviceName
Dim wmiRoot
Dim wmiQuery
Dim objWMIService
Dim colServices
Dim oservice
Dim colNamedArguments
Set colNamedArguments = WScript.Arguments.Named
computerName = colNamedArguments("computer")
serviceName = colNamedArguments("service")
subCheckArgs
wmiRoot = "winmgmts:\\" & computerName & "\root\cimv2"
wmiQuery = "Select state from Win32_Service" & " where name = " & "'" & serviceName & "'"

Set bjWMIService = GetObject(wmiRoot)
Set colServices = objWMIService.ExecQuery(wmiQuery)
For Each oservice In colServices
   WScript.Echo serviceName & " Is: " & oservice.state & " on: " & computerName
Next

Sub subCheckArgs
If colNamedArguments.Count < 2 Then
If colNamedArguments.exists("computer") Then
serviceName = "spooler"
WScript.Echo "using default service: spooler"
Else If colNamedArguments.Exists("Service") Then
computerName = "localHost"
WScript.Echo "using default computer: localhost"
Else
WScript.Echo "you must supply two arguments" _
& " to this script." & VbCrLf & "Try this: " _
& "Cscript. checkNamedArgCS.vbs /computer:" _
& "localhost /service:spooler"      
WScript.Quit
End If
End If
End If
End Sub

From

Microsoft@ VBScript. Step by Step
By Ed Wilson

CMD command prompt and use the following command:

Cscript. argComputerService.vbs localhost lanmanserver

the result:lanmanserver Is: Running on: localhost

ArgComputerService.vbs

Option Explicit
On Error Resume Next
Dim computerName
Dim serviceName
Dim wmiRoot
Dim wmiQuery
Dim objWMIService
Dim colServices
Dim oservice

computerName = WScript.Arguments(0)
serviceName = WScript.Arguments(1)
wmiRoot = "winmgmts:\\" & computerName & "\root\cimv2"
Set bjWMIService = GetObject(wmiRoot)
wmiQuery = "Select state from Win32_Service" &_
   " where name = " & "'" & serviceName & "'"
Set colServices = objWMIService.ExecQuery _
  (wmiQuery)
For Each oservice In colServices
   WScript.Echo (serviceName) & " Is: "&_
   oservice.state & (" on: ") & computerName
Next

From

Microsoft@ VBScript. Step by Step
By Ed Wilson

Command-Line Arguments

Command-line arguments provide you with the ability to modify the execution of a script. prior to running it.

CheckArgsPingMultipleComputers.vbs

Option Explicit
On Error Resume Next
Dim strComputer
Dim aMachines,machine
Dim objPing,objStatus

YourNameComputerRoles Solution.vbs

Option Explicit
'On Error Resume Next
Dim strComputer
Dim wmiRoot
Dim wmiQuery
Dim colComputers
Dim objComputer
Dim objWMIService
Dim strComputerRole,strComputerName,strDomainName,strUserName
strComputer = "."
wmiRoot = "winmgmts:\\" & strComputer & "\root\cimv2"
wmiQuery = "Select * from Win32_ComputerSystem"

Set bjWMIService = GetObject(wmiRoot)
Set colComputers = objWMIService.ExecQuery(wmiQuery)
For Each objComputer In colComputers
  strComputerRole = funComputerRole(objComputer.DomainRole)
  strComputerName = objComputer.Name
  strDomainName = objComputer.Domain
  strUserName = objComputer.UserName
  WScript.Echo  strComputerRole & VbCrLf & strComputerName _
  & VbCrLf & strDomainName & VbCrLf & strUserName
  Next
WScript.Echo("all done")
Function funComputerRole(intIN)
 Select Case intIN
  Case 0
    funComputerRole = "Standalone Workstation"
  Case 1
    funComputerRole = "Member Workstation"
  Case 2
    funComputerRole = "Standalone Server"
  Case 3
    funComputerRole = "Member Server"
  Case 4
    funComputerRole = "Backup Domain Controller"
  Case 5
    funComputerRole = "Primary Domain Controller"
  Case Else
  funComputerRole = "Look this one up in SDK"
 End Select
End Function

YourNameEnableDHCPSolution.vbs

Option Explicit
'On Error Resume Next
Dim strComputer
Dim wmiRoot
Dim wmiQuery
Dim objWMIService
Dim colNetAdapters,objNetAdapter,DHCPEnabled
strComputer = "."
wmiRoot = "winmgmts:\\" & strComputer & "\root\cimv2"
wmiQuery = "Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE"

Set bjWMIService = GetObject(wmiRoot)
Set colNetAdapters = objWMIService.ExecQuery (wmiQuery)
For Each objNetAdapter In colNetAdapters
DHCPEnabled = objNetAdapter.EnableDHCP()
If DHCPEnabled = 0 Then
  WScript.Echo "DHCP has been enabled."
  Else
  WScript.Echo "DHCP could not be enabled."
End If
Next

If...Then...ElseIf adds some flexibility to your ability to make decisions by using VBScript. If...Then enables you to evaluate one condition and take action based on that condition. By adding ElseIf to the mixture, you can make multiple decisions.

Example:Get the CPU informaiton

Option Explicit
'On Error Resume Next
Dim strPrompt
Dim strTitle
Dim intBTN
Dim intRTN
Dim FSO
strPrompt = "Do you want to run the script?"
strTitle = "MSGBOX DEMO"
intBTN = 3
intRTN = MsgBox (strPrompt,intBTN,strTitle)
If intRTN = vbYes Then
WScript.Echo "yes was pressed"
subCPU
ElseIf intRTN = vbNo Then
WScript.Echo "no was pressed"
WScript.quit
ElseIf intRTN = vbCancel Then
WScript.Echo "cancel was pressed"
WScript.quit
Else
WScript.Echo intRTN & " was pressed"
WScript.quit
End If

Sub subCPU()
Dim strComputer
Dim cpu
Dim wmiRoot
Dim objWMIService
Dim ObjProcessor
strComputer = "."
cpu = "win32_Processor='CPU0'"
wmiRoot = "winmgmts:\\" & strComputer & "\root\cimv2"
Set bjWMIService = GetObject(wmiRoot)
Set bjProcessor = objWMIService.Get(cpu)
If objProcessor.Architecture = 0 Then
  WScript.Echo "This is an x86 cpu."
ElseIf objProcessor.Architecture = 1 Then
  WScript.Echo "This is a MIPS cpu."
ElseIf objProcessor.Architecture = 2 Then
  WScript.Echo "This is an Alpha cpu."
ElseIf objProcessor.Architecture = 3 Then
  WScript.Echo "This is a PowerPC cpu."
ElseIf objProcessor.Architecture = 6 Then
  WScript.Echo "This is an ia64 cpu."
Else
  WScript.Echo "Cannot determine cpu type."
End If
End Sub

change the If...Then...ElseIf to Select Case...Case...End Select

Option Explicit
'On Error Resume Next
Dim strComputer
Dim wmiRoot
Dim wmiQuery
Dim objWMIService
Dim colItems
Dim objItem

strComputer = "."
wmiRoot = "winmgmts:\\" & strComputer & "\root\cimv2"
wmiQuery = "Select DomainRole from Win32_ComputerSystem"

Set bjWMIService = GetObject(wmiRoot)
Set colItems = objWMIService.ExecQuery _
  (wmiQuery)
For Each objItem in colItems
  WScript.Echo funComputerRole(objItem.DomainRole)
Next

Function funComputerRole(intIN)
 Select Case intIN
  Case 0
    funComputerRole = "Standalone Workstation"
  Case 1
    funComputerRole = "Member Workstation"
  Case 2
    funComputerRole = "Standalone Server"
  Case 3
    funComputerRole = "Member Server"
  Case 4
    funComputerRole = "Backup Domain Controller"
  Case 5
    funComputerRole = "Primary Domain Controller"
  Case Else
  funComputerRole = "Look this one up in SDK"
 End Select
End Function

From

Microsoft@ VBScript. Step by Step
By Ed Wilson