Frequently Asked Stuff -
Updated 12/04/2009 COMING SOON! Table of Content for ease of navigation as requested by TNO Just posting links or code to various questions I have seen members ask...will try to update often.
Why bother with this when people can
Search like we often recommend members to do? Well, because if you're new you probably don't know the keywords to search for and if you do...you may not find it even though you remember seeing it.
If you are new here, Welcome, and make sure to read this post since it has a lot of useful information:
http://www.visualbasicscript.com/m_24727/tm.htm TIP: Running your script using cscript.exe in conjunction with WScript.Echo is a great way to debug you code and ensure you are getting/setting the values you want.
Informative/Tutorial Links 1. HTML (good practice by
TNO):
http://www.visualbasicscript.com/m_58515/tm.htm 2. HTML DOM:
http://www.w3schools.com/htmldom/default.asp
Active Directory Browsing
1. Active Directory Explorer is similar to ADSI; you can see the objects properties by simply selecting it; date/time values are converted for easy reading as well.
http://technet.microsoft.com/en-us/sysinternals/bb963907.aspx Add current date to file name; How do I format the current date to include it in the file name? 1. This could be one way to achieve this...
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim fileName : fileName = "C:\temp\OutputFile-" & FormatDate(Date) & ".txt"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFSO.OpenTextFile(fileName, ForWriting, True)
objFile.WriteLine "Test"
objFile.Close
Function FormatDate(inputDate)
Dim arrDate : arrDate = Split(inputDate, "/")
If Len(arrDate(0)) = 1 Then arrDate(0) = "0" & arrDate(0)
If Len(arrDate(1)) = 1 Then arrDate(1) = "0" & arrDate(1)
FormatDate = arrDate(0) & arrDate(1) & arrDate(2) 'MMDDYYYY
End Function
2. Another format date function
WScript.Echo GetFormatedDate(Now, "yyyymmdd")
Function GetFormatedDate(inputDate, strFormat)
Dim intMonth : intMonth = Right("00" & Month(inputDate), 2)
Dim intDay : intDay = Right("00" & Day(inputDate), 2)
Dim intYear : intYear = Year(inputDate)
Select Case strFormat
Case "mmddyyyy" GetFormatedDate = intMonth & intDay & intYear
Case "ddmmyyyy" GetFormatedDate = intDay & intMonth & intYear
Case "yyyymmdd" GetFormatedDate = intYear & intMonth & intDay
Case "yyyyddmm" GetFormatedDate = intYear & intDay & intMonth
Case Else GetFormatedDate = intMonth & intDay & intYear
End Select
End Function
3. ...and another example
WScript.Echo GetCustomDate
Function GetCustomDate
GetCustomDate = Year(Now()) & _
Right("00" & Month(Now()), 2) & _
Right("00" & Day(Now()), 2)
End Function
Add or include external vbs files in a script You can use
ExecuteGlobal to accomplish this
1. http://www.visualbasicscript.com/m_29285/tm.htm 2. http://www.visualbasicscript.com/m_47332/tm.htm Add Missing Printers 1. One method would be....
Option Explicit
' create a dictionary to store our printer paths
Dim objDictPrnts : Set objDictPrnts = CreateObject("Scripting.Dictionary")
objDictPrnts.CompareMode = vbTextCompare
objDictPrnts.Add "\\Server01\Printer001", "\\Server01\Printer001"
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
Dim colPrinters : Set colPrinters = objNetwork.EnumPrinterConnections
Dim intCounter, strPrinterPath
For intCounter = 0 To colPrinters.Count - 1 Step 2
strPrinterPath = colPrinters.Item(intCounter + 1)
' if the current path exist in our dictionary remove it
If objDictPrnts.Exists(strPrinterPath) Then objDictPrnts.Remove strPrinterPath
Next
For Each strPrinterPath In objDictPrnts.Keys
objNetwork.AddWindowsPrinterConnection strPrinterPath
Next
AD (Active Directory) Queries 1. http://www.visualbasicscript.com/m_40609/tm.htm Compare 2 text files; How can I compare the content of two text files? 1. http://www.microsoft.com/technet/scriptcenter/resources/qanda/may07/hey0524.mspx CSV Parsing 1. http://www.visualbasicscript.com/m_42611/tm.htm CSV To XLS 1. You can open it as a .CSV with Excel and save it as a .XLS
Const xlWorkbookNormal = -4143
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open "c:\temp\test.csv"
objExcel.ActiveWorkbook.SaveAs "c:\temp\test2.xls", xlWorkbookNormal
objExcel.Quit
CSV/Tab Seperated text file parsing using ADO 1. http://msdn2.microsoft.com/en-us/library/ms974559.aspx 2. http://www.microsoft.com/technet/scriptcenter/resources/qanda/may05/hey0524.mspx DSOFile.dll; read & write file properties such as author, title, comments, keywords, etc. 1. http://www.microsoft.com/downloads/details.aspx?FamilyID=9ba6fac6-520b-4a0a-878a-53ec8300c4c2&DisplayLang=en (download DLL)
2. http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1001.mspx 3. http://www.microsoft.com/technet/scriptcenter/resources/tales/sg0305.mspx Directory; get subdirectories using WMI where folders contain characters such as { } ' 1. To get around this you need to use a pair of double quotes instead of single when specifying the directory name and use two \\ instead of one. See the example below.
Option Explicit
Dim strComputer : strComputer = "."
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Dim colSubfolders : Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name=""c:\\temp\\{test}""}" _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
Dim objFolder
For Each objFolder In colSubfolders
WScript.Echo objFolder.Name
Next
Directory - Create a directory or folder path 1. ebgreen shows us a great way to accomplish this using the GetParentFolderName method of FSO
http://www.visualbasicscript.com/m_38933/tm.htm
Sub SmartCreateFolder(strFolder)
Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(strFolder) Then
Exit Sub
Else
SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
End If
oFSO.CreateFolder(strFolder)
Set oFSO = Nothing
End Sub
Dynamic Constant; set a constant at time of execution I know this is a contradiction...but
DiGiTAL.SkReAM shows a way of accomplishing this using
ExecuteGlobal ...especially since he knows how
ebgreen feels about this "hack"
1. http://www.visualbasicscript.com/m_46780/tm.htm E-Mail 1. One way
Sub Email(strSender, strRcpt, strSubject, strBody, strSMTPServer)
Dim objMessage : Set objMessage = CreateObject("CDO.Message")
objMessage.From = strSender
objMessage.To = strRcpt
objMessage.Subject = strSubject
objMessage.HTMLBody = strBody
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
End Sub
Encryption 1. http://www.4guysfromrolla.com/webtech/010100-1.shtml 2. http://www.visualbasicscript.com/m_48428/tm.htm Excel - Save/Convert to CSV 1. http://www.visualbasicscript.com/m_46004/tm.htm File; Log File; Limit Size 1. ehvbs offers an example of how to accomplish this:
http://www.visualbasicscript.com/fb.aspx?m=68660
Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sFSpec : sFSpec = ".\updated.log"
Dim nMxLines : nMxLines = 4
If oFS.FileExists( sFSpec ) Then oFS.DeleteFile sFSpec
Dim nTest
For nTest = 1 To Int( nMxLines * 2.5 )
logUpdater sFSpec, "Message # " & nTest, nMxLines
WScript.Echo Join( Array( String( 30, "-" ), oFS.OpenTextFile( sFSpec ).ReadAll, String( 30, "-" ) ), vbCrLf )
Next
Sub logUpdater( sFSpec, sMsg, nMxLines )
Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim aLines
If oFS.FileExists( sFSpec ) Then
aLines = splitFileLines( sFSpec )
If UBound( aLines ) => (nMxLines - 1) Then
Dim nLine
For nLine = 1 To UBound( aLines )
aLines( nLine - 1 ) = aLines( nLine )
Next
Else
ReDim Preserve aLines( UBound( aLines ) + 1 )
End If
aLines( UBound( aLines ) ) = sMsg
Else
aLines = Array( sMsg )
End If
oFS.CreateTextFile( sFSpec ).WriteLine Join( aLines, vbCrLf )
End Sub
Function splitFileLines( sFSpec )
Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sAll : sAll = oFS.OpenTextFile( sFSpec ).ReadAll
Dim oRE : Set oRE = New RegExp
oRE.Pattern = "(?:\r\n)+$"
sAll = oRE.Replace( sAll, "" )
splitFileLines = Split( sAll, vbCrLf )
End Function
Free COM Objects: 1. http://www.visualbasicscript.com/m_54830/tm.htm 2. http://www.xstandard.com/en/downloads/ FTP 1. http://www.chilkatsoft.com/ChilkatFtp.asp 2. http://www.visualbasicscript.com/m_44703/tm.htm 3. FTP Search 4. Free FTP DLL
http://www.primalscript.com/Free_Tools/index.asp Function/Sub - GetRef; Execute, Eval
Option Explicit
Main()
Sub Main()
' using Execute
Execute "WScript.Echo TestFunc(""abc1"", ""def1"")"
'using Eval
WScript.Echo Eval("TestFunc(""abc2"", ""def2"")")
'using GetRef
WScript.Echo GetRef("TestFunc")("abc3", "def3")
End Sub
Function TestFunc(strTemp1, strTemp2)
TestFunc = strTemp1 & " - " & strTemp2
End Function
Function/Sub - Global & Local variables
1. http://www.visualbasicscript.com/m_45440/tm.htm 2. http://www.visualbasicscript.com/m_40908/tm.htm Function - Return Multiple Values; How to return multiple values? 1. One method would be to use an array.
Option Explicit
DoSomethingSub
Sub DoSomethingSub
Dim arrNetworkInfo : arrNetworkInfo = GetInfo()
WScript.Echo "Computer Name: " & arrNetworkInfo(0)
WScript.Echo "Domain Name: " & arrNetworkInfo(1)
WScript.Echo "User Name: " & arrNetworkInfo(2)
End Sub
Function GetInfo
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
Dim arrTemp(2)
arrTemp(0) = objNetwork.ComputerName
arrTemp(1) = objNetwork.UserDomain
arrTemp(2) = objNetwork.UserName
GetInfo = arrTemp
End Function
2. Another method would be to use a dictionary to return the values...making it easier to reference the values when you need to use them.
Option Explicit
DoSomethingSub()
Sub DoSomethingSub()
Dim objNetInfoDict : Set objNetInfoDict = GetInfo()
WScript.Echo "Computer Name: " & objNetInfoDict("computername")
WScript.Echo "Domain Name: " & objNetInfoDict("domainname")
WScript.Echo "User Name: " & objNetInfoDict("username")
End Sub
Function GetInfo
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
objDict.Add "computername", objNetwork.ComputerName
objDict.Add "domainname", objNetwork.UserDomain
objDict.Add "username", objNetwork.UserName
Set GetInfo = objDict
End Function
Get Additional File Info
1.
Option Explicit
Main()
Sub Main()
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFilePath : strFilePath = "C:\temp\test.txt"
GetFileDetails objFSO, strFilePath
End Sub
Sub GetFileDetails(objFSO, strFilePath)
Dim strParentFolder : strParentFolder = objFSO.GetParentFolderName(strFilePath)
Dim strFileName : strFileName = objFSO.GetFileName(strFilePath)
Dim objShell : Set objShell = CreateObject("Shell.Application")
Dim objFolder : Set objFolder = objShell.NameSpace(strParentFolder)
Dim objFile : Set objFile = objFolder.ParseName(strFileName)
Dim intCount, strHeader, strValue
For intCount = 0 To 47
strHeader = objFolder.GetDetailsOf(objFolder.Items, intCount)
strValue = objFolder.GetDetailsOf(objFile, intCount)
If strValue <> "" Then
WScript.Echo strHeader & ":" & Space(40 - Len(strHeader)) & strValue
End If
Next
End Sub
Get Local or Remote User Name
1. Local UserName using WSHNetwork
WScript.Echo GetUserName
Function GetUserName
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
GetUserName = objNetwork.UserName
End Function
2. Local UserName using ADSystemInfo; useful if you intend to bind to the users AD object
WScript.Echo GetADUserName
Function GetADUserName
Dim ADSysInfo : Set ADSysInfo = CreateObject("ADSystemInfo")
GetUserName = ADSysInfo.UserName
End Function
3. Local or Remote UserName using WMI and Win32_ComputerSystem class; a period "." indicates the local PC
WScript.Echo GetUserName(".")
Function GetUserName(strComputer)
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\cimv2")
Dim colOS : Set colOS = objWMIService.ExecQuery(_
"Select * From Win32_ComputerSystem")
Dim strUserName : strUserName = ""
Dim objOS
For Each objOS In colOS
strUserName = objOS.UserName
Next
GetUserName = strUserName
End Function
4. Local or Remote UserName using WMI and Win32_Process; determine user by looking at the explorer.exe process
and more reliable than #3 above.
WScript.Echo GetUserName(".")
Function GetUserName(strComputer)
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\cimv2")
Dim colProcesses : Set colProcesses = objWMIService.ExecQuery(_
"Select * From Win32_Process Where Name = 'explorer.exe'")
Dim objProcess, strUserName, strDomainName
For Each objProcess In colProcesses
objProcess.GetOwner strUserName, strDomainName
Next
GetUserName = strDomainName & "\" & strUserName
End Function
Get OS/SP Version, Disable/Enable IE Check Zone, Compare File Version, Delete File/Folder 1. Check out
mbouchard's post:
http://www.visualbasicscript.com/m_57816/tm.htm Gif2Hex; Gif to Hex; text representation of an image
1. Courtesy of
Meg:
http://www.visualbasicscript.com/m_53444/tm.htm Login Script 1. Map Drives - XML Based:
http://www.visualbasicscript.com/m_52191/tm.htm Read a File Into an Array 1. ehvbs posted a method here:
http://www.visualbasicscript.com/m_47020/tm.htm 2. A simple method...
NOTE: This method does not take into consideration any unnecessary blank spaces at the end of you file so you may get empty array elements!
Dim arrTxtFile : arrTxtFile = ReadTxtToArray("c:\temp\test.txt")
Function ReadTxtToArray(strInputFilePath)
Const ForReading = 1
' create FSO
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' open text file for reading
Dim objFile : Set objFile = objFSO.OpenTextFile(strInputFilePath, ForReading)
' read the content of the file and split into an array using vbCrLf as the seperator
' and return the array
ReadTxtToArray = Split(objFile.ReadAll, VbCrLf)
' close the file
objFile.Close
End Function
3. Read a File to an Array using Regular Expressions to remove preceeding/trailing blank lines
Option Explicit
Dim arrTemp : arrTemp = ReadFileToArray("c:\temp\test.txt")
Dim intIndex
For intIndex = 0 To UBound(arrTemp)
WScript.Echo arrTemp(intIndex)
Next
Function ReadFileToArray(strFilePath)
Const ForReading = 1
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFSO.OpenTextFile(strFilePath, ForReading)
Dim strInputText : strInputText = objFile.ReadAll
objFile.Close
Dim RegEx : Set RegEx = New RegExp
RegEx.Global = True : RegEx.MultiLine = True
RegEx.Pattern = "\s+$" ' remove trailing spaces/blank lines
strInputText = RegEx.Replace(strInputText, "")
RegEx.Pattern = "^\s+" ' remove preceding spaces
strInputText = RegEx.Replace(strInputText, "")
ReadFileToArray = Split(strInputText, VbCrLf)
End Function
Get Web Content 1. http://www.microsoft.com/technet/scriptcenter/scripts/misc/intnet/msitvb01.mspx How can I find a computer a user is logged into? Find logged in user.
The short answer is there is no easy way to get this info. See the link below for a discussion on this same question.
1. http://www.visualbasicscript.com/m_42096/mpage_1/tm.htm How can I force my script to run in CScript? 1. Based off a post by
mbouchard.
ForceCScript
Sub ForceCScript
' check to see if cscript was used to execute the script
If InStr(1, WScript.FullName, "cscript", vbTextCompare) = 0 Then
' if it was NOT executed using cscript.exe, create a shell object
Dim objShell : Set objShell = CreateObject("WScript.Shell")
' re-execute the script using cscript.exe
objShell.Run "%comspec% /c cscript.exe " & _
WScript.ScriptFullName & " /nologo"
' quit the current script
WScript.Quit
End If
End Sub
How can I generate a random number? 1. http://www.visualbasicscript.com/m_46705/tm.htm 2. http://www.microsoft.com/technet/technetmag/issues/2007/01/HeyScriptingGuy/default.aspx (towards the end of the article)
How can I get a folders file count? Folder Recursion 1. This would be one way.
Option Explicit
GetFileCount()
Sub GetFileCount()
' define variable and set the initial folder path
Dim strFolderPath : strFolderPath = "C:\temp"
' define variable to hold file count
Dim intFileCount : intFileCount = 0
' create FSO
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' call RecurseFolder sub to look at subfolders and file count
RecurseFolder objFSO.GetFolder(strFolderPath), intFileCount
' echo output
WScript.Echo "Total File Count For " & _
Chr(34) & strFolderPath & Chr(34) & _
" = " & intFileCount
End Sub
Sub RecurseFolder(objFolder, intFileCount)
' On Error Resume Next
' add the file count for the current folder to intFileCount
intFileCount = intFileCount + objFolder.Files.Count
' On Error GoTo 0
Dim objSubFolder
' loop through sub folders
For Each objSubFolder In objFolder.SubFolders
' On Error Resume Next
' have the sub call itself sending the sub folder path
RecurseFolder objSubFolder, intFileCount
' On Error GoTo 0
Next
End Sub
2. ehvbs additions to the code above:
http://www.visualbasicscript.com/m_49006/tm.htm 3. Basic folder recursion, recurse folder, enumerate files and folders
Option Explicit
Main()
Sub Main()
' create FSO
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
RecurseFolder objFSO.GetFolder("c:\temp")
End Sub
Sub RecurseFolder(objFolder)
' On Error Resume Next
Dim objFile
For Each objFile In objFolder.Files
WScript.Echo "File: " & objFile.Path
Next
' On Error Goto 0
' On Error Resume Next
Dim objSubFolder
' loop through sub folders
For Each objSubFolder In objFolder.SubFolders
WScript.Echo "Folder: " & objSubFolder.Path
' have the sub call itself sending the sub folder path
RecurseFolder objSubFolder
Next
' On Error Goto 0
End Sub
4. This is an example of recursing through a folder and searching for specific file extensions and returning their path and datelastmodified
Option Explicit
SearchForFiles
Sub SearchForFiles
' define variable and set the initial folder path
Dim strFolderPath : strFolderPath = "C:\Temp"
' create Dictionary to keep track of files that match our criteria
Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
' create FSO
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' create regular expression
Dim RegEx : Set RegEx = New RegExp
' specify the extension you want to search for; seperate with a |
' currently searching for .txt and .mdb files
RegEx.Pattern = "\.(txt|mdb)$"
RegEx.IgnoreCase = True
' call RecurseFolder sub to look at subfolders
RecurseFolder objFSO.GetFolder(strFolderPath), RegEx, objDict
' display how many files where found
WScript.Echo "Found " & objDict.Count & " files matching your criteria!"
' loop through the paths in the dictionary
Dim strFilePath
For Each strFilePath In objDict.Keys
' display the file path and datelastmodified
WScript.Echo strFilePath & vbTab & objDict(strFilePath)
Next
End Sub
Sub RecurseFolder(objFolder, RegEx, objDict)
On Error Resume Next
Dim objFile, strFileName
' loop through files
For Each objFile In objFolder.Files
strFileName = objFile.Path
' test to see if the file matches the extension defined w/ the RegExp
' currently adding the file path and datelastmodified to the dictionary
If RegEx.Test(strFileName) Then objDict.Add strFileName, objFile.DateLastModified
Next
On Error GoTo 0
On Error Resume Next
Dim objSubFolder
' loop through sub folders
For Each objSubFolder In objFolder.SubFolders
' have the sub call itself sending the sub folder path
RecurseFolder objSubFolder, RegEx, objDict
Next
On Error GoTo 0
End Sub
5. This is a very neat way to search using dir.exe (which is extremely fast):
http://www.visualbasicscript.com/m_47844/tm.htm 6. This is not necessarily file count but it deals with Files and Folders using FSO:
http://www.microsoft.com/technet/scriptcenter/resources/begin/ss0507.mspx 7. Recurse a folder X number of directories deep.
Option Explicit
RecurseXDeep "C:\temp", 3
Sub RecurseXDeep(strFolderPath, intDirDeep)
Dim RegEx : Set RegEx = New RegExp
RegEx.Pattern = Replace(strFolderPath, "\", "\\") & _
"\\?([^\\]+\\?){" & intDirDeep & "}$"
RegEx.IgnoreCase = True
RegEx.Global = True
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
RecurseFolder objFSO.GetFolder(strFolderPath), objDict, RegEx
WScript.Echo Join(objDict.Keys, VbCrLf)
End Sub
Sub RecurseFolder(objFolder, objDict, RegEx)
Dim objFile
For Each objFile In objFolder.Files
objDict.Add objFile.Path, ""
Next
Dim objSubFolder
For Each objSubFolder In objFolder.SubFolders
If RegEx.Test(objSubFolder.Path) Then RecurseFolder objSubFolder, objDict, RegEx
Next
End Sub
8. Recursive Delete Files/SubFolders
FSO Method1
Option Explicit
CleanUp "C:\temp\testfolder"
Sub CleanUp(strFolderPath)
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strFolderPath) Then
DeleteContent objFSO.GetFolder(strFolderPath)
End If
End Sub
Sub DeleteContent(objFolder)
Dim objFile
For Each objFile In objFolder.Files
objFile.Delete True
Next
Dim objSubFolder
For Each objSubFolder In objFolder.SubFolders
DeleteContent objSubFolder
objSubFolder.Delete True
Next
End Sub
FSO Method2
Option Explicit
CleanUp "C:\temp\testfolder"
Sub CleanUp(strFolderPath)
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strFolderPath) Then
DeleteContent objFSO.GetFolder(strFolderPath)
End If
End Sub
Sub DeleteContent(objFolder)
Dim objFile
For Each objFile In objFolder.Files
objFile.Delete True
Next
Dim objSubFolder
For Each objSubFolder In objFolder.SubFolders
objSubFolder.Delete True
Next
End Sub
WMI Version
Option Explicit
CleanUp "c:\temp\testfolder"
Sub CleanUp(strFolderPath)
Dim strComputer : strComputer = "."
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\cimv2")
DeleteContent objWMIService, strFolderPath
End Sub
Sub DeleteContent(objWMIService, strFolderPath)
On Error Resume Next
Dim strDriveLetter : strDriveLetter = Split(strFolderPath, "\")(0)
Dim strPath : strPath = Mid(Replace(strFolderPath, "\", "\\"), 3) & "\\"
Dim colFiles : Set colFiles = objWMIService.ExecQuery("Select * From " & _
"CIM_DataFile Where Drive='" & strDriveLetter & "' " & _
"And Path=""" & strPath & """")
Dim objFile
For Each objFile In colFiles
objFile.Delete()
Next
Dim colFolders : Set colFolders = objWMIService.ExecQuery("Associators Of {Win32_Directory.Name=""" & _
Replace(strFolderPath, "\", "\\") & """} Where AssocClass=" & _
"Win32_SubDirectory ResultRole=PartComponent")
Dim objSubFolder
For Each objSubFolder In colFolders
DeleteContent objWMIService, objSubFolder.Name
objSubFolder.Delete()
Next
On Error GoTo 0
End Sub
How can I get the input from an HTML back to my VBScript? 1. Tom Lavedas shows the following example
http://members.cox.net/tglbatch/wsh/PasswordBox.vbs.txt
' Just an example of how to use the function
'
wsh.echo "You entered: ", _
Join(PasswordBox("Enter UID and password", _
"Testing"), ", ")
' A function to present a Password dialog in a VBS (WSF)
' script
' Requires WScript version 5.1+
' Tom Lavedas <tlavedas@hotmail.com>
' with help from and thanks to Joe Ernest and
' Michael Harris
'
' modified 1/2008 to handle IE7
'
Function PasswordBox(sPrompt, sDefault)
set oIE = CreateObject("InternetExplorer.Application")
With oIE
' Configure the IE window
.RegisterAsDropTarget = False
.statusbar = false : .toolbar = false
.menubar = false : .addressbar = false
.Resizable = False
.Navigate "about:blank"
Do Until .ReadyState = 4 : WScript.Sleep 50 : Loop
' Test for IE 7 - cannot remove 'chrome' in that version
sVersion = .document.parentWindow.navigator.appVersion
if instr(sVersion, "MSIE 7.0") = 0 Then .FullScreen = True
.width = 400 : .height = 270
' Create the password box document
With .document
oIE.left = .parentWindow.screen.width \ 2 - 200
oIE.top = .parentWindow.screen.height\ 2 - 100
.open
.write "<html><head><" & "script>bboxwait=true;</" _
& "script><title>Password _</title></head>"_
& "<body bgColor=silver scroll=no " _
& "language=vbs style='border-" _
& "style:outset;border-Width:3px'" _
& " onHelp='window.event.returnvalue=false" _
& ":window.event.cancelbubble=true'" _
& " oncontextmenu=" _
& "'window.event.returnvalue=false" _
& ":window.event.cancelbubble=true'" _
& " onkeydown='if ((window.event.keycode>111)"_
& " and (window.event.keycode<117)) or" _
& " window.event.ctrlkey then" _
& " window.event.keycode=0" _
& ":window.event.cancelbubble=true" _
& ":window.event.returnvalue=false'" _
& " onkeypress='if window.event.keycode=13" _
& " then bboxwait=false'><center>" _
& "<div style='padding:10px;background-color:lightblue'>" _
& "<b> " & sPrompt & "<b> </div><p>" _
& "<table bgcolor=cornsilk cellspacing=10><tr><td>" _
& " <b>User:</b></td><td>" _
& "<input type=text size=10 id=user value='" _
& sDefault & "'>" _
& "</td><tr><td> <b>Password:</b></td><td>" _
& "<input type=password size=12 id=pass>" _
& "</td></tr></table><br>" _
& "<button onclick='bboxwait=false;'>" _
& " Okay " _
& "</button> <button onclick=" _
& "'document.all.user.value=""CANCELLED"";" _
& "document.all.pass.value="""";" _
& "bboxwait=false;'>Cancel" _
& "</button></center></body></html>"
.close
Do Until .ReadyState = "complete" : WScript.Sleep 100 : Loop
.all.user.focus
.all.user.select ' Optional
oIE.Visible = True
CreateObject("Wscript.Shell")_
.Appactivate "Password _"
PasswordBox = Array("CANCELLED")
On Error Resume Next
Do While .parentWindow.bBoxWait
if Err Then Exit Function
WScript.Sleep 100
Loop
oIE.Visible = False
PasswordBox = Array(.all.user.value, _
.all.pass.value)
End With ' document
End With ' IE
End Function
How can I pause an HTA? What can I use in an HTA instead of WScript.Sleep? There are a few things you can try an use.
1. window.setInterval("FunctionorSubName", 1000) ' the 1000 is 1 second
2. window.setTimeout("FunctionorSubName", 1000)
3. Another method would be to create a Sub to pause for us.
Sleep 5 'pause for approx 5 seconds
Sub Sleep(intTimeWait)
' create shell object
Dim objShell : Set objShell = CreateObject("WScript.Shell")
' ping loopback using a timeout of 1 sec to stall the script
objShell.Run "%comspec% /c ping.exe 127.0.0.1 -w 1000 -n " & _
intTimeWait + 1, 0, True
End Sub
4. Another method would be to call an external .vbs file that takes as an argument the sleep time
Sleep 1000
Sub Sleep(intTimeWait)
' create shell object
Dim objShell : Set objShell = CreateObject("WScript.Shell")
' execute external sleep.vbs script and pass the wait time to it
objShell.Run "cscript.exe sleep.vbs " & intTimeWait, 0, True
End Sub
How can I sort files in a folder into different folders? 1. The following is a very simple example of moving files from one folder into 5 separate folders. It uses the FileSystemObject to get the files and move them. The Mod operator is used to help assist in the sorting of the files into the various folders.
Option Explicit
Main()
Sub Main()
' define source folder containing files to move
Dim strSourceFolder : strSourceFolder = "C:\Temp"
' define desination folders where files will be distributed to
' NOTE: make sure the destination folder paths end with a \
Dim arrDestFolders : arrDestFolders = Array("C:\Temp\Folder1\", _
"C:\Temp\Folder2\", _
"C:\Temp\Folder3\", _
"C:\Temp\Folder4\", _
"C:\Temp\Folder5\")
' get the total destination folder count
Dim intDFCount : intDFCount = UBound(arrDestFolders) + 1
' define FSO object
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' check if the source folder path exists
If objFSO.FolderExists(strSourceFolder) Then
' get folder
Dim objFolder : Set objFolder = objFSO.GetFolder(strSourceFolder)
' verify if destination folder paths exists; exit sub if one does not exist
Dim strDestFolder
For Each strDestFolder In arrDestFolders
If Not objFSO.FolderExists(strDestFolder) Then
WScript.Echo strDestFolder & " - does not exist; exiting script"
Exit Sub
End If
Next
' begin looping through files and sorting them into the folders
Dim intFileCount : intFileCount = 0
Dim objFile
For Each objFile In objFolder.Files
'WScript.Echo intFileCount Mod intDFCount
objFile.Move arrDestFolders(intFileCount Mod intDFCount)
intFileCount = intFileCount + 1
Next
End If
End Sub
How can I sort my array? 1. Component by
TNO that has array related functions (including sort):
http://www.visualbasicscript.com/fb.aspx?m=59479
2. http://www.microsoft.com/technet/technetmag/issues/2007/01/HeyScriptingGuy/default.aspx (Bubble Sort & .Net Array Sort)
How do I get an applications uninstall string from the registry?
1. One way would be to enumerate the subkeys in the registry under HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
Option Explicit
' Define HKLM constant
Const HKLM = &H80000002
' Make WMI connection to the local PC
Dim objReg : Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
' specify the application to search for; can be exact (preferred) or partial since
' the InStr function is being used
Dim strAppName : strAppName = "flash"
Dim strUninstallKeyPath : strUninstallKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
' Enumberate subKeys under Uninstall
Dim arrSubKeys
objReg.EnumKey HKLM, strUninstallKeyPath, arrSubKeys
If IsArray(arrSubKeys) Then
' Loop through subKeys
Dim strSubKey, strDisplayName, strUninstallKeyPath1, strUninstall
For Each strSubKey In arrSubKeys
' build keypath to see values under the app subkeys
strUninstallKeyPath1 = strUninstallKeyPath & "\" & strSubKey
' get the string value for the Displayname
objReg.GetStringValue HKLM, strUninstallKeyPath1, "DisplayName", strDisplayName
' compare the display name with what we're looking for;
' NOTE: not all installs have a DisplayName
If Not IsNull(strDisplayName) Then
If InStr(UCase(strDisplayName), UCase(strAppName)) Then
' if we find a match try to get the uninstall String
objReg.GetStringValue HKLM, strUninstallKeyPath1, "UNINSTALLSTRING", strUninstall
' show the unisntall string; used inputbox here to make it easy to copy and paste
' to easily verify if the string works fine without any additional switches
' can then be replaced/modified/etc to fit your needs.
InputBox "Uninstall String", "Uninstall String", strUninstall
End If
End If
Next
End If
How do I make my script wait for a process to terminate? 1. One way would be using WMI and the Win32_Process Class
WaitForProcess ".", "notepad.exe"
WScript.Echo "Notepad is no longer running...continue with script!"
Sub WaitForProcess(strComputer, strProcess)
Dim wmiQuery : wmiQuery = "Select * From Win32_Process Where Name='" _
& strProcess & "'"
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & strComputer _
& "\root\cimv2")
Dim colItems : Set colItems = objWMIService.ExecQuery(wmiQuery)
Dim intProcCount : intProcCount = colItems.Count
Do While intProcCount > 0
Set colItems = objWMIService.ExecQuery(wmiQuery)
intProcCount = colItems.Count
WScript.Sleep 1000
Loop
End Sub
HTA Dynamicically Populate a drop down 1. http://www.visualbasicscript.com/m_47106/tm.htm MD5 Checksum 1. Free COM dll:
http://www.xstandard.com/en/downloads/ Ping 1. http://www.visualbasicscript.com/m_42535/tm.htm 2. WMI (another way)
Function Reachable(strComputer)
Reachable = False
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Dim objPing : Set objPing = objWMIService.Get("Win32_PingStatus.Address='" & strComputer & "'")
If objPing.StatusCode = 0 Then Reachable = True
End Function
Progress Bar Found these post by searching for the word "Progress"
1. http://www.visualbasicscript.com/m_32390/tm.htm 2. http://www.visualbasicscript.com/m_40601/tm.htm 3. http://www.visualbasicscript.com/m_41561/tm.htm 4. http://www.visualbasicscript.com/m_24746/tm.htm 5. http://www.visualbasicscript.com/m_47750/tm.htm 6. http://www.microsoft.com/technet/scriptcenter/scripts/misc/progress/default.mspx Accessing SQL, MS Access, MS Excel using ADO 1. SQL Ref -
http://www.w3schools.com/sql/sql_quickref.asp 2. SQL/Access -
http://www.microsoft.com/technet/scriptcenter/scripts/misc/database/default.mspx 3. MS Access -
http://www.microsoft.com/technet/scriptcenter/resources/officetips/nov05/tips1103.mspx 4. MS Excel -
http://www.microsoft.com/technet/scriptcenter/resources/officetips/jun05/tips0607.mspx 5. Connection Strings -
http://www.connectionstrings.com/ 6. SQL Syntax -
http://www.devguru.com/Technologies/sqlsyntax/quickref/sql_syntax_intro.html 7. Here is a simple example accessing an Access .mdb
Option Explicit
' define constants of ADO
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
' define the Access DB path
Const DBPath = "C:\temp\test.mdb"
Main()
Sub Main
' create adodb connection & recordset objects
Dim objConn : Set objConn = CreateObject("ADODB.Connection")
Dim objRecordSet : Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
' define query
Dim strSQLQuery : strSQLQuery = "SELECT * FROM Table1 WHERE TestField1='test123'"
If QueryTable(objConn, objRecordSet, strSQLQuery) Then
' display the record count
WScript.Echo "Record count: " & objRecordSet.RecordCount
' loop through all records returned
Do Until objRecordSet.EOF
' specify the field you want echoed out
WScript.Echo objRecordSet.Fields.Item("testfield2")
' move to the next record
objRecordSet.MoveNext
Loop
Else
WScript.Echo "No record found matching you query!"
End If
' close connections
objRecordSet.Close
objConn.Close
End Sub
Function QueryTable(objConn, objRecordSet, strQuery)
objConn.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & DBPath
objRecordSet.Open strQuery, objConn, adOpenStatic, adLockOptimistic
' if the query returns a value then move to the first record & return true
If Not objRecordSet.EOF Then
objRecordSet.MoveFirst
QueryTable = True
Else
' return false if query do not return anything
QueryTable = False
End If
End Function
Registry 1. http://www.visualbasicscript.com/m_31698/tm.htm#32023 2. Set wallpaper for
ALL users
http://www.visualbasicscript.com/m_47074/tm.htm 3. Set registry value for
ALL users (based on the code in the link above)
http://www.visualbasicscript.com/m_51805/tm.htm Regular Expressions; RegExp, RegEx
1. http://www.ilovejackdaniels.com/regular_expressions_cheat_sheet.pdf 2. http://msdn2.microsoft.com/en-us/library/yab2dx62.aspx 3. http://www.regular-expressions.info/ 4. http://regexlib.com/default.aspx Telnet 1. http://www.visualbasicscript.com/m_38306/tm.htm VBS to EXE; Convert .vbs to .exe; convert vbscript to executable 1. http://www.visualbasicscript.com/m_29193/tm.htm Wait for a process to become idle for a certain amount of time in seconds Based off a post by
morpheus83uk 1. http://www.visualbasicscript.com/m_46514/tm.htm
WaitForIdle ".", "firefox", "5"
Sub WaitForIdle(strComputer, strProcessName, intIdleSec)
Dim bolIdle : bolIdle = False
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Dim strObjKeyPath : strObjKeyPath = "Win32_PerfRawData_PerfProc_Process.Name='" & strProcessName & "'"
Dim objPerfInstance : Set objPerfInstance = objWMIService.get(strObjKeyPath)
Dim intPercProcTime1 : intPercProcTime1 = objPerfInstance.PercentProcessorTime
Dim intProcTimeStamp1 : intProcTimeStamp1 = objPerfInstance.TimeStamp_Sys100NS
Dim intElemCount : intElemCount = CInt(intIdleSec) - 1
ReDim arrProcPercents(intElemCount)
Dim i : i = 0
Dim PercentProcessorTime, arrTemp, intPercProcTime2, intProcTimeStamp2
Do While Not bolIdle
WScript.Sleep 1000
Set objPerfInstance = objWMIService.get(strObjKeyPath)
intPercProcTime2 = objPerfInstance.PercentProcessorTime
intProcTimeStamp2 = objPerfInstance.TimeStamp_Sys100NS
If (intProcTimeStamp2 - intProcTimeStamp1) = 0 Then
WScript.Echo "Error, probably " & strProcessName & " not found running"
Exit Do
Else
PercentProcessorTime = ((intPercProcTime2 - intPercProcTime1) _
/ (intProcTimeStamp2 - intProcTimeStamp1))
' WScript.Echo FormatPercent(PercentProcessorTime)
' add value to array
arrProcPercents(i) = FormatPercent(PercentProcessorTime)
' if the number of seconds have been met then check the array
If i = (intElemCount) Then
' look at the array and filter for values of 0.00%
arrTemp = Filter(arrProcPercents, "0.00%")
' if the array size of the filtered and the original is the same then
' all the values for the time specified where 0.00%
If UBound(arrTemp) = intElemCount Then
' set bolIdle = True to exit the Do...Loop
bolIdle = True
End If
' if all the values where not 0.00% then reset the counter and
' array index to update
i = 0
Else
' increment the counter/array index
i = i + 1
End If
End If
intPercProcTime1 = intPercProcTime2
intProcTimeStamp1 = intProcTimeStamp2
Loop
End Sub
Why doesn't this objShell.Run "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe" work?? (...getting error: The system cannot find the file specified )
Well the reason for this is the empty spaces in the path. A solution is to add the additional quotes.
1. EBGreen posted a function similar to the one below that works great.
' create shell object
Dim objShell : Set objShell = CreateObject("WScript.Shell")
' execute app adding quotes to the path using the AddQuotes function
objShell.Run AddQuotes("C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe")
Function AddQuotes(strInput)
' add leading and trailing quotes to string passed into the function and return
AddQuotes = Chr(34) & strInput & Chr(34)
End Function
2. You could also use double quotes, but that can start getting confusing
' create shell object
Dim objShell : Set objShell = CreateObject("WScript.Shell")
' add additional quotes to run properly
objShell.Run """C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe"""
3. Here is an HTA to assist with converting from command line to use with vbscript (WSHShell Run or Exec method)
http://www.visualbasicscript.com/m_69925/tm.htm
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<!--
Usage:
Launch HTA, copy **WORKING** command line string/command into
"CMD String" text area, place the "Variable Replacement String"
specified string anywhere in your command line string/command
where you would eventually use a variable in your VBScript,
copy the content in the "VBS String" text area and use in your VBScript,
change the variable names as necessary for use in your script.
Example:
i.e. (copy one of the lines below as the cmd string into the text area)
"C:\Program Files\App Folder\App.exe"
"C:\Program Files\App Folder\App.exe" /r /f:strMyVariable /g:"strMyVariable"
-->
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Command Line String to VBS (Run or Exec Method)</title>
<script language="vbscript" type="text/vbscript">
Option Explicit
Sub window_onload()
window.resizeTo 900, 400
End Sub
Sub cmdString_onKeyUp()
' get string from cmd text area
Dim strCMDString : strCMDString = window.document.getElementById("cmdString").value
' replace each " with two " and add " to the beginning and end of the string
strCMDString = Chr(34) & Replace(strCMDString, Chr(34), Chr(34) & Chr(34)) & Chr(34)
' get the replacement string
Dim strRepString : strRepString = window.document.getElementById("repString").value
' replace the replacement string with the " & variablestring & "
strCMDString = Replace(strCMDString, strRepString, _
Chr(34) & " & " & strRepString & " & " & Chr(34), _
1, -1, vbTextCompare)
' output formatted string to vbs text area
window.document.getElementById("vbsString").value = strCMDString
End Sub
</script>
<hta:application
applicationname="Command Line String to VBS (Run or Exec Method)"
border="dialog"
borderstyle="normal"
caption="Command Line String to VBS (Run or Exec Method)"
contextmenu="yes"
icon=""
maximizebutton="yes"
minimizebutton="yes"
navigable="no"
scroll="no"
selection="yes"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
version="1.0"
windowstate="normal"
>
<style type="text/css">
body {
background-color: #191B1C;
overflow: auto;
color: #FFFFFF;
}
h1
{
text-align: center;
}
textarea {
overflow: auto;
}
</style>
</head>
<body>
<h1>
Command Line String to VBS
<br/>(Run or Exec Method)
</h1>
<br>
<table width="100%">
<tr>
<td>Variable Replacement String:</td>
<td><input type="text" id="repString" value="strMyVariable" readonly />
(use this string to insert variables)
</td>
</tr>
<tr>
<td>CMD String:</td>
<td><textarea id="cmdString" cols="80" rows="5"></textarea></td>
</tr>
<tr>
<td>VBS String:</td>
<td><textarea id="vbsString" cols="80" rows="5" readonly></textarea></td>
</tr>
</table>
</body>
</html>
...or javascript version
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<!--
Usage:
Launch HTA, copy **WORKING** command line string/command into
"CMD String" text area, place the "Variable Replacement String"
specified string anywhere in your command line string/command
where you would eventually use a variable in your VBScript,
copy the content in the "VBS String" text area and use in your VBScript,
change the variable names as necessary for use in your script.
Example:
i.e. (copy one of the lines below as the cmd string into the text area)
"C:\Program Files\App Folder\App.exe"
"C:\Program Files\App Folder\App.exe" /r /f:strMyVariable /g:"strMyVariable"
-->
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Command Line String to VBS (Run or Exec Method)</title>
<script type="text/javascript">
function cmdString_onkeyup()
{
// get string from cmd text ara
var strCMDString = window.document.getElementById("cmdString").value
// replace each " with two " and add " to the beginning and end of the string
strCMDString = "\"" + strCMDString.replace(new RegExp("\"", "gi"), "\"\"") + "\""
var strRepString = window.document.getElementById("repString").value
// replace the replacement string with the " & variablestring & "
window.document.getElementById("vbsString").value = strCMDString.replace(
new RegExp(strRepString, "gi"),
"\" & " + strRepString + " & \"")
}
</script>
<style type="text/css">
body {
background-color: #191B1C;
overflow: auto;
color: #FFFFFF;
}
h1
{
text-align: center;
}
textarea {
overflow: auto;
}
</style>
</head>
<body>
<h1>
Command Line String to VBS
<br/>(Run or Exec Method)
</h1>
<br>
<table width="100%">
<tr>
<td>Variable Replacement String:</td>
<td><input type="text" id="repString" value="strMyVariable" readonly />
(use this string to insert variables)
</td>
</tr>
<tr>
<td>CMD String:</td>
<td><textarea id="cmdString" cols="80" rows="5" onkeyup="cmdString_onkeyup()"></textarea></td>
</tr>
<tr>
<td>VBS String:</td>
<td><textarea id="vbsString" cols="80" rows="5" readonly></textarea></td>
</tr>
</table>
</body>
</html>
WMI Permanent Event Filter; Consumer 1. http://www.visualbasicscript.com/m_67041/tm.htm Zip Files 1. http://www.visualbasicscript.com/m_46632/tm.htm 2. See files inside a ZIP file (tested on WinXP)...figured it was possible from the link directly above.
Option Explicit
LookInZipFile
Sub LookInZipFile
' define the path to you zip file
Dim strZipFilePath : strZipFilePath = "c:\temp\test.zip"
' create shell.application object
Dim objShellApp : Set objShellApp = CreateObject("Shell.Application")
' call the ShowFilesInZip sub and pass shell object and zip file path
ShowFilesInZip objShellApp, strZipFilePath
End Sub
Sub ShowFilesInZip(objShellApp, strZipFilePath)
' retrieve the file collection in the zip file
Dim colFiles : Set colFiles = objShellApp.NameSpace(strZipFilePath).Items
' echo out the zip file path
WScript.Echo strZipFilePath
' loop through the file collection and echo out the file names
Dim objFile
For Each objFile In colFiles
WScript.Echo vbTab & objFile.Name
Next
End Sub
<message edited by dm_4ever on Friday, December 04, 2009 3:54 AM>