VBScript Hints and Tips

Get Full Script Name

FullName = WScript.ScriptFullName

Parts of the name can then be extracted with a FileSystemObject. For example:

Set ofs = CreateObject("Scripting.FileSystemObject")
ScriptDir = ofs.GetParentFolderName(ScriptPath)

Get all network drives on a remote computer

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & strComputer & "rootcimv2")

Set colDrives = objWMIService.ExecQuery _
    ("Select * From Win32_LogicalDisk Where DriveType = 4")

For Each objDrive in colDrives
    Wscript.Echo "Drive letter: " & objDrive.DeviceID
    Wscript.Echo "Network path: " & objDrive.ProviderName

Script to convert an XLSX file to XLS file

This is useful when you are working a lot with both Excel 2003 and Excel 2007/10.

In Win XP, you can save it in a .VBS file and link to it from %userprofile%SendTo, and it will appear in your “Send To” context menu.

You can then right-click an XLSX file, and choose Send To-><this script name> and it will convert for you.

Requires Excel 2007/10.

Sub ConvertToXLS()
        Set oFS = CreateObject("Scripting.FileSystemObject")
        sFile =  WScript.Arguments(0)
        sExt = UCase(oFS.GetExtensionName(sFile))

        If sExt<>"XLSX" Then
                MsgBox "Not an XLSX file."
                Exit Sub
        End If

        sNewFile = oFS.GetParentFolderName(sFile) & "" & oFS.GetBaseName(sFile) & ".xls"
        If oFS.FileExists(sNewFile) Then
                If MsgBox("Are you sure you wish to overwrite the existing xls file?", 4)<>6 Then
                        Exit Sub
                End If
        End If

        Set oXL = CreateObject("Excel.Application")

        Set oWkb = oXL.Workbooks.Open(sFile)

        If oFS.FileExists(sNewFile) Then oFS.DeleteFile(sNewFile)

        alerts_ = oXL.DisplayAlerts
        oXL.DisplayAlerts = false
        oWkb.SaveAs sNewFile, 56,,,,,,false
        oXL.DisplayAlerts = alerts_
End Sub

Call ConvertToXLS()

Windows Installer 64-bit Post Install Script for VS2010

Visual Studio 2010 creates invalid 64-bit packages. This post-setup script will embed the correct InstallUtil for 64-bit machines.

Option Explicit

If WScript.arguments.Count <> 1 Then
        MsgBox "64-bit Installer Post-build scripting: Wrong number of args."
End IF

Const msiOpenDatabaseModeTransact     = 1
Const msiViewModifyAssign         = 3
Const msiOpenDatabaseModeDirect = 2

Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer")

Dim sqlQuery : sqlQuery = "SELECT `Name`, `Data` FROM `Binary` WHERE `Name`='InstallUtil'"

Dim database : Set database = installer.OpenDatabase(WScript.arguments(0), msiOpenDatabaseModeDirect)
Dim view     : Set view = database.OpenView(sqlQuery)
Dim record


Set record = view.Fetch()

record.SetStream 2, "C:WindowsMicrosoft.NETFramework64v4.0.30319InstallUtilLib.dll"

view.Modify msiViewModifyAssign, record 
Set view = Nothing
Set database = Nothing